1 /* -----------------------------------------------------------------------------
2 * $Id: MBlock.c,v 1.16 2000/08/04 23:31:44 lewie 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 base_non_committed = VirtualAlloc ( NULL
181 if ( base_non_committed == 0 ) {
183 fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
187 /* The returned pointer is not aligned on a mega-block boundary. Make it. */
188 base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)0xfff00000) + MBLOCK_SIZE;
190 fprintf(stderr, "Dropping %d bytes off of 128M chunk\n",
191 (unsigned)base_mblocks - (unsigned)base_non_committed);
194 if ( ((char*)base_mblocks + size) > ((char*)base_non_committed + SIZE_RESERVED_POOL) ) {
196 fprintf(stderr, "oops, committed too small a region to start with.");
200 next_request = base_mblocks;
204 /* Commit the mega block(s) to phys mem */
205 if ( ret != (void*)-1 ) {
206 ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
209 fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
215 if (((W_)ret & MBLOCK_MASK) != 0) {
216 barf("GetMBlock: misaligned block returned");
219 IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
221 next_request = (char*)next_request + size;
223 mblocks_allocated += n;
228 /* Hand back the physical memory that is allocated to a mega-block.
229 ToDo: chain the released mega block onto some list so that
230 getMBlocks() can get at it.
236 freeMBlock(void* p, nat n)
240 rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
244 fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());