1 /* -----------------------------------------------------------------------------
2 * $Id: MBlock.c,v 1.20 2000/12/16 15:20:30 panne 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);
69 ret = mmap(next_request, size, PROT_READ | PROT_WRITE,
70 MAP_ANON | MAP_PRIVATE, -1, 0);
73 if (ret == (void *)-1) {
74 if (errno == ENOMEM) {
75 barf("getMBlock: out of memory");
77 barf("GetMBlock: mmap failed");
81 if (((W_)ret & MBLOCK_MASK) != 0) {
82 barf("GetMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
85 IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
89 mblocks_allocated += n;
97 On Win32 platforms we make use of the two-phased virtual memory API
98 to allocate mega blocks. We proceed as follows:
100 Reserve a large chunk of VM (128M at the time), but don't supply a
101 base address that's aligned on a MB boundary. Instead we round up to the
102 nearest from the chunk of VM we're given back from the OS (at the
103 moment we just leave the 'slop' at the beginning of the reserved
104 chunk unused - ToDo: reuse it .)
106 Reserving memory doesn't allocate physical storage (not even in the
107 page file), this is done by committing pages (or mega-blocks in
112 char* base_non_committed = (char*)0;
114 /* Reserve VM 128M at the time to try to minimise the slop cost. */
115 #define SIZE_RESERVED_POOL ( 128 * 1024 * 1024 )
117 /* This predicate should be inlined, really. */
118 /* TODO: this only works for a single chunk */
120 is_heap_alloced(const void* x)
122 return (((char*)(x) >= base_non_committed) &&
123 ((char*)(x) <= (base_non_committed + SIZE_RESERVED_POOL)));
129 static char* base_mblocks = (char*)0;
130 static char* next_request = (char*)0;
131 void* ret = (void*)0;
133 lnat size = MBLOCK_SIZE * n;
135 if ( (base_non_committed == 0) ||
136 (next_request + size > base_non_committed + SIZE_RESERVED_POOL) ) {
137 #ifdef ENABLE_WIN32_DLL_SUPPORT
138 if (base_non_committed)
139 barf("Windows programs can only use 128Mb of heap; sorry!");
141 base_non_committed = VirtualAlloc ( NULL
146 if ( base_non_committed == 0 ) {
148 fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\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, "Dropping %d bytes off of 128M chunk\n",
156 (unsigned)base_mblocks - (unsigned)base_non_committed);
159 if ( ((char*)base_mblocks + size) > ((char*)base_non_committed + SIZE_RESERVED_POOL) ) {
161 fprintf(stderr, "oops, committed too small a region to start with.");
165 next_request = base_mblocks;
169 /* Commit the mega block(s) to phys mem */
170 if ( ret != (void*)-1 ) {
171 ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
174 fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
180 if (((W_)ret & MBLOCK_MASK) != 0) {
181 barf("GetMBlock: misaligned block returned");
184 IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
186 next_request = (char*)next_request + size;
188 mblocks_allocated += n;
193 /* Hand back the physical memory that is allocated to a mega-block.
194 ToDo: chain the released mega block onto some list so that
195 getMBlocks() can get at it.
201 freeMBlock(void* p, nat n)
205 rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
209 fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());