1 /* -----------------------------------------------------------------------------
2 * $Id: MBlock.c,v 1.23 2001/08/14 13:40:09 sewardj Exp $
4 * (c) The GHC Team 1998-1999
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.
10 * ---------------------------------------------------------------------------*/
12 /* This is non-posix compliant. */
13 /* #include "PosixSource.h" */
19 #include "BlockAlloc.h"
25 #ifdef HAVE_SYS_TYPES_H
26 #include <sys/types.h>
29 #ifndef mingw32_TARGET_OS
30 # ifdef HAVE_SYS_MMAN_H
31 # include <sys/mman.h>
43 lnat mblocks_allocated = 0;
55 static caddr_t next_request = (caddr_t)HEAP_BASE;
57 lnat size = MBLOCK_SIZE * n;
59 #ifdef solaris2_TARGET_OS
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);
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);
73 ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
74 MAP_ANON | MAP_PRIVATE, -1, 0);
77 if (ret == (void *)-1) {
78 if (errno == ENOMEM) {
79 barf("getMBlock: out of memory");
81 barf("GetMBlock: mmap failed");
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);
89 IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %p\n",n,ret));
93 mblocks_allocated += n;
101 On Win32 platforms we make use of the two-phased virtual memory API
102 to allocate mega blocks. We proceed as follows:
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 .)
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
116 char* base_non_committed = (char*)0;
118 /* Reserve VM 128M at the time to try to minimise the slop cost. */
119 #define SIZE_RESERVED_POOL ( 128 * 1024 * 1024 )
121 /* This predicate should be inlined, really. */
122 /* TODO: this only works for a single chunk */
124 is_heap_alloced(const void* x)
126 return (((char*)(x) >= base_non_committed) &&
127 ((char*)(x) <= (base_non_committed + SIZE_RESERVED_POOL)));
133 static char* base_mblocks = (char*)0;
134 static char* next_request = (char*)0;
135 void* ret = (void*)0;
137 lnat size = MBLOCK_SIZE * n;
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!");
145 base_non_committed = VirtualAlloc ( NULL
150 if ( base_non_committed == 0 ) {
152 fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
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;
159 fprintf(stderr, "Dropping %d bytes off of 128M chunk\n",
160 (unsigned)base_mblocks - (unsigned)base_non_committed);
163 if ( ((char*)base_mblocks + size) > ((char*)base_non_committed + SIZE_RESERVED_POOL) ) {
165 fprintf(stderr, "oops, committed too small a region to start with.");
169 next_request = base_mblocks;
173 /* Commit the mega block(s) to phys mem */
174 if ( ret != (void*)-1 ) {
175 ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
178 fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
184 if (((W_)ret & MBLOCK_MASK) != 0) {
185 barf("GetMBlock: misaligned block returned");
188 IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
190 next_request = (char*)next_request + size;
192 mblocks_allocated += n;
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.
205 freeMBlock(void* p, nat n)
209 rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
213 fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());