1 /* -----------------------------------------------------------------------------
2 * $Id: MBlock.c,v 1.18 2000/09/06 11:12:07 rrt 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 #define NON_POSIX_SOURCE
18 #include "BlockAlloc.h"
24 #ifdef HAVE_SYS_TYPES_H
25 #include <sys/types.h>
28 #ifndef mingw32_TARGET_OS
29 # ifdef HAVE_SYS_MMAN_H
30 # include <sys/mman.h>
42 #if freebsd2_TARGET_OS || freebsd_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.
48 #define ASK_FOR_MEM_AT 0x50000000
50 #elif netbsd_TARGET_OS
51 /* NetBSD i386 shared libs are at 0x40000000
53 #define ASK_FOR_MEM_AT 0x50000000
54 #elif openbsd_TARGET_OS
55 #define ASK_FOR_MEM_AT 0x50000000
59 #define ASK_FOR_MEM_AT 0x50000000
61 #elif solaris2_TARGET_OS
63 #define ASK_FOR_MEM_AT 0x50000000
67 #define ASK_FOR_MEM_AT 0x50000000
71 #define ASK_FOR_MEM_AT 0x50000000
74 /* doesn't matter, we use a reserve/commit algorithm */
77 #error Dont know where to get memory from on this architecture
78 /* ToDo: memory locations on other architectures */
81 lnat mblocks_allocated = 0;
93 static caddr_t next_request = (caddr_t)ASK_FOR_MEM_AT;
95 lnat size = MBLOCK_SIZE * n;
97 #ifdef solaris2_TARGET_OS
99 int fd = open("/dev/zero",O_RDONLY);
100 ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
101 MAP_FIXED | MAP_PRIVATE, fd, 0);
105 ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
106 MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
108 ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
109 MAP_ANON | MAP_PRIVATE, -1, 0);
112 if (ret == (void *)-1) {
113 if (errno == ENOMEM) {
114 barf("getMBlock: out of memory");
116 barf("GetMBlock: mmap failed");
120 if (((W_)ret & MBLOCK_MASK) != 0) {
121 barf("GetMBlock: misaligned block returned");
124 IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
126 next_request += size;
128 mblocks_allocated += n;
136 On Win32 platforms we make use of the two-phased virtual memory API
137 to allocate mega blocks. We proceed as follows:
139 Reserve a large chunk of VM (128M at the time), but don't supply a
140 base address that's aligned on a MB boundary. Instead we round up to the
141 nearest from the chunk of VM we're given back from the OS (at the
142 moment we just leave the 'slop' at the beginning of the reserved
143 chunk unused - ToDo: reuse it .)
145 Reserving memory doesn't allocate physical storage (not even in the
146 page file), this is done by committing pages (or mega-blocks in
151 char* base_non_committed = (char*)0;
153 /* Reserve VM 128M at the time to try to minimise the slop cost. */
154 #define SIZE_RESERVED_POOL ( 128 * 1024 * 1024 )
156 /* This predicate should be inlined, really. */
157 /* TODO: this only works for a single chunk */
159 is_heap_alloced(const void* x)
161 return (((char*)(x) >= base_non_committed) &&
162 ((char*)(x) <= (base_non_committed + SIZE_RESERVED_POOL)));
168 static char* base_mblocks = (char*)0;
169 static char* next_request = (char*)0;
170 void* ret = (void*)0;
172 lnat size = MBLOCK_SIZE * n;
174 if ( (base_non_committed == 0) ||
175 (next_request + size > base_non_committed + SIZE_RESERVED_POOL) ) {
176 #ifdef ENABLE_WIN32_DLL_SUPPORT
177 if (base_non_committed)
178 barf("Windows programs can only use 128Mb of heap; sorry!");
180 base_non_committed = VirtualAlloc ( NULL
185 if ( base_non_committed == 0 ) {
187 fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
191 /* The returned pointer is not aligned on a mega-block boundary. Make it. */
192 base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)0xfff00000) + MBLOCK_SIZE;
194 fprintf(stderr, "Dropping %d bytes off of 128M chunk\n",
195 (unsigned)base_mblocks - (unsigned)base_non_committed);
198 if ( ((char*)base_mblocks + size) > ((char*)base_non_committed + SIZE_RESERVED_POOL) ) {
200 fprintf(stderr, "oops, committed too small a region to start with.");
204 next_request = base_mblocks;
208 /* Commit the mega block(s) to phys mem */
209 if ( ret != (void*)-1 ) {
210 ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
213 fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
219 if (((W_)ret & MBLOCK_MASK) != 0) {
220 barf("GetMBlock: misaligned block returned");
223 IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
225 next_request = (char*)next_request + size;
227 mblocks_allocated += n;
232 /* Hand back the physical memory that is allocated to a mega-block.
233 ToDo: chain the released mega block onto some list so that
234 getMBlocks() can get at it.
240 freeMBlock(void* p, nat n)
244 rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
248 fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());