1 /* -----------------------------------------------------------------------------
2 * $Id: MBlock.c,v 1.24 2001/10/26 11:49:19 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 256M at the time to try to minimise the slop cost. */
119 #define SIZE_RESERVED_POOL ( 256 * 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 if (base_non_committed)
142 barf("Windows programs can only use 256Mb of heap; sorry!");
143 base_non_committed = VirtualAlloc ( NULL
148 if ( base_non_committed == 0 ) {
149 fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
152 /* The returned pointer is not aligned on a mega-block boundary. Make it. */
153 base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)0xfff00000) + MBLOCK_SIZE;
155 fprintf(stderr, "getMBlocks: Dropping %d bytes off of 256M chunk\n",
156 (unsigned)base_mblocks - (unsigned)base_non_committed);
159 if ( ((char*)base_mblocks + size) > ((char*)base_non_committed + SIZE_RESERVED_POOL) ) {
160 fprintf(stderr, "getMBlocks: oops, committed too small a region to start with.");
163 next_request = base_mblocks;
167 /* Commit the mega block(s) to phys mem */
168 if ( ret != (void*)-1 ) {
169 ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
171 fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %ld\n", GetLastError());
176 if (((W_)ret & MBLOCK_MASK) != 0) {
177 barf("getMBlocks: misaligned block returned");
180 if (ret == (void*)-1) {
181 barf("getMBlocks: unknown memory allocation failure on Win32.");
184 IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at 0x%x\n",n,(nat)ret));
185 next_request = (char*)next_request + size;
187 mblocks_allocated += n;
192 /* Hand back the physical memory that is allocated to a mega-block.
193 ToDo: chain the released mega block onto some list so that
194 getMBlocks() can get at it.
200 freeMBlock(void* p, nat n)
204 rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
208 fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());