1 /* -----------------------------------------------------------------------------
2 * $Id: MBlock.c,v 1.21 2001/01/16 11:54:25 simonmar 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 lnat mblocks_allocated = 0;
54 static caddr_t next_request = (caddr_t)HEAP_BASE;
56 lnat size = MBLOCK_SIZE * n;
58 #ifdef solaris2_TARGET_OS
60 int fd = open("/dev/zero",O_RDONLY);
61 ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
62 MAP_FIXED | MAP_PRIVATE, fd, 0);
66 ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
67 MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
68 #elif macosx_TARGET_OS
69 ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
70 MAP_FIXED | MAP_ANON | MAP_PRIVATE, -1, 0);
72 ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
73 MAP_ANON | MAP_PRIVATE, -1, 0);
76 if (ret == (void *)-1) {
77 if (errno == ENOMEM) {
78 barf("getMBlock: out of memory");
80 barf("GetMBlock: mmap failed");
84 if (((W_)ret & MBLOCK_MASK) != 0) {
85 barf("GetMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
88 IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
92 mblocks_allocated += n;
100 On Win32 platforms we make use of the two-phased virtual memory API
101 to allocate mega blocks. We proceed as follows:
103 Reserve a large chunk of VM (128M at the time), but don't supply a
104 base address that's aligned on a MB boundary. Instead we round up to the
105 nearest from the chunk of VM we're given back from the OS (at the
106 moment we just leave the 'slop' at the beginning of the reserved
107 chunk unused - ToDo: reuse it .)
109 Reserving memory doesn't allocate physical storage (not even in the
110 page file), this is done by committing pages (or mega-blocks in
115 char* base_non_committed = (char*)0;
117 /* Reserve VM 128M at the time to try to minimise the slop cost. */
118 #define SIZE_RESERVED_POOL ( 128 * 1024 * 1024 )
120 /* This predicate should be inlined, really. */
121 /* TODO: this only works for a single chunk */
123 is_heap_alloced(const void* x)
125 return (((char*)(x) >= base_non_committed) &&
126 ((char*)(x) <= (base_non_committed + SIZE_RESERVED_POOL)));
132 static char* base_mblocks = (char*)0;
133 static char* next_request = (char*)0;
134 void* ret = (void*)0;
136 lnat size = MBLOCK_SIZE * n;
138 if ( (base_non_committed == 0) ||
139 (next_request + size > base_non_committed + SIZE_RESERVED_POOL) ) {
140 #ifdef ENABLE_WIN32_DLL_SUPPORT
141 if (base_non_committed)
142 barf("Windows programs can only use 128Mb of heap; sorry!");
144 base_non_committed = VirtualAlloc ( NULL
149 if ( base_non_committed == 0 ) {
151 fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
155 /* The returned pointer is not aligned on a mega-block boundary. Make it. */
156 base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)0xfff00000) + MBLOCK_SIZE;
158 fprintf(stderr, "Dropping %d bytes off of 128M chunk\n",
159 (unsigned)base_mblocks - (unsigned)base_non_committed);
162 if ( ((char*)base_mblocks + size) > ((char*)base_non_committed + SIZE_RESERVED_POOL) ) {
164 fprintf(stderr, "oops, committed too small a region to start with.");
168 next_request = base_mblocks;
172 /* Commit the mega block(s) to phys mem */
173 if ( ret != (void*)-1 ) {
174 ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
177 fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
183 if (((W_)ret & MBLOCK_MASK) != 0) {
184 barf("GetMBlock: misaligned block returned");
187 IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
189 next_request = (char*)next_request + size;
191 mblocks_allocated += n;
196 /* Hand back the physical memory that is allocated to a mega-block.
197 ToDo: chain the released mega block onto some list so that
198 getMBlocks() can get at it.
204 freeMBlock(void* p, nat n)
208 rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
212 fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());