+RTS -xbXXXXX sets the "heap base" to 0xXXXXXX
[ghc-hetmet.git] / rts / sm / MBlock.c
1 /* -----------------------------------------------------------------------------
2  *
3  * (c) The GHC Team 1998-1999
4  *
5  * MegaBlock Allocator Interface.  This file contains all the dirty
6  * architecture-dependent hackery required to get a chunk of aligned
7  * memory from the operating system.
8  *
9  * ---------------------------------------------------------------------------*/
10
11 /* This is non-posix compliant. */
12 /* #include "PosixSource.h" */
13
14 #include "Rts.h"
15 #include "RtsUtils.h"
16 #include "RtsFlags.h"
17 #include "MBlock.h"
18 #include "BlockAlloc.h"
19 #include "Trace.h"
20
21 #ifdef HAVE_STDLIB_H
22 #include <stdlib.h>
23 #endif
24 #ifdef HAVE_STRING_H
25 #include <string.h>
26 #endif
27 #ifdef HAVE_UNISTD_H
28 #include <unistd.h>
29 #endif
30 #ifdef HAVE_SYS_TYPES_H
31 #include <sys/types.h>
32 #endif
33 #ifndef mingw32_HOST_OS
34 # ifdef HAVE_SYS_MMAN_H
35 # include <sys/mman.h>
36 # endif
37 #endif
38 #ifdef HAVE_FCNTL_H
39 #include <fcntl.h>
40 #endif
41 #if HAVE_WINDOWS_H
42 #include <windows.h>
43 #endif
44 #if darwin_HOST_OS
45 #include <mach/vm_map.h>
46 #endif
47
48 #include <errno.h>
49
50 lnat mblocks_allocated = 0;
51
52 #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS)
53 static caddr_t next_request = 0;
54 #endif
55
56 void
57 initMBlocks(void)
58 {
59 #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS)
60     next_request = (caddr_t)RtsFlags.GcFlags.heapBase;
61 #endif
62 }
63
64 /* -----------------------------------------------------------------------------
65    The MBlock Map: provides our implementation of HEAP_ALLOCED()
66    -------------------------------------------------------------------------- */
67
68 #if SIZEOF_VOID_P == 4
69 StgWord8 mblock_map[MBLOCK_MAP_SIZE]; // initially all zeros
70 #elif SIZEOF_VOID_P == 8
71 static MBlockMap dummy_mblock_map;
72 MBlockMap *mblock_cache = &dummy_mblock_map;
73 int mblock_map_count = 0;
74 MBlockMap **mblock_maps = NULL;
75
76 static MBlockMap *
77 findMBlockMap(void *p)
78 {
79     int i;
80     StgWord32 hi = (StgWord32) (((StgWord)p) >> 32);
81     for( i = 0; i < mblock_map_count; i++ )
82     {
83         if(mblock_maps[i]->addrHigh32 == hi)
84         {
85             return mblock_maps[i];
86         }
87     }
88     return NULL;
89 }
90
91 StgBool
92 slowIsHeapAlloced(void *p)
93 {
94     MBlockMap *map = findMBlockMap(p);
95     if(map)
96     {
97         mblock_cache = map;
98         return map->mblocks[MBLOCK_MAP_ENTRY(p)];
99     }
100     else
101         return 0;
102 }
103 #endif
104
105 static void
106 markHeapAlloced(void *p)
107 {
108 #if SIZEOF_VOID_P == 4
109     mblock_map[MBLOCK_MAP_ENTRY(p)] = 1;
110 #elif SIZEOF_VOID_P == 8
111     MBlockMap *map = findMBlockMap(p);
112     if(map == NULL)
113     {
114         mblock_map_count++;
115         mblock_maps = realloc(mblock_maps,
116                               sizeof(MBlockMap*) * mblock_map_count);
117         map = mblock_maps[mblock_map_count-1] = calloc(1,sizeof(MBlockMap));
118         map->addrHigh32 = (StgWord32) (((StgWord)p) >> 32);
119     }
120     map->mblocks[MBLOCK_MAP_ENTRY(p)] = 1;
121     mblock_cache = map;
122 #endif
123 }
124
125 /* -----------------------------------------------------------------------------
126    Allocate new mblock(s)
127    -------------------------------------------------------------------------- */
128
129 void *
130 getMBlock(void)
131 {
132   return getMBlocks(1);
133 }
134
135 /* -----------------------------------------------------------------------------
136    The mmap() method
137
138    On Unix-like systems, we use mmap() to allocate our memory.  We
139    want memory in chunks of MBLOCK_SIZE, and aligned on an MBLOCK_SIZE
140    boundary.  The mmap() interface doesn't give us this level of
141    control, so we have to use some heuristics.
142
143    In the general case, if we want a block of n megablocks, then we
144    allocate n+1 and trim off the slop from either side (using
145    munmap()) to get an aligned chunk of size n.  However, the next
146    time we'll try to allocate directly after the previously allocated
147    chunk, on the grounds that this is aligned and likely to be free.
148    If it turns out that we were wrong, we have to munmap() and try
149    again using the general method.
150
151    Note on posix_memalign(): this interface is available on recent
152    systems and appears to provide exactly what we want.  However, it
153    turns out not to be as good as our mmap() implementation, because
154    it wastes extra space (using double the address space, in a test on
155    x86_64/Linux).  The problem seems to be that posix_memalign()
156    returns memory that can be free()'d, so the library must store
157    extra information along with the allocated block, thus messing up
158    the alignment.  Hence, we don't use posix_memalign() for now.
159
160    -------------------------------------------------------------------------- */
161
162 #if !defined(mingw32_HOST_OS) && !defined(cygwin32_HOST_OS)
163
164 // A wrapper around mmap(), to abstract away from OS differences in
165 // the mmap() interface.
166
167 static void *
168 my_mmap (void *addr, lnat size)
169 {
170     void *ret;
171
172 #if defined(solaris2_HOST_OS) || defined(irix_HOST_OS)
173     { 
174         int fd = open("/dev/zero",O_RDONLY);
175         ret = mmap(addr, size, PROT_READ | PROT_WRITE, MAP_PRIVATE, fd, 0);
176         close(fd);
177     }
178 #elif hpux_HOST_OS
179     ret = mmap(addr, size, PROT_READ | PROT_WRITE, 
180                MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
181 #elif darwin_HOST_OS
182     // Without MAP_FIXED, Apple's mmap ignores addr.
183     // With MAP_FIXED, it overwrites already mapped regions, whic
184     // mmap(0, ... MAP_FIXED ...) is worst of all: It unmaps the program text
185     // and replaces it with zeroes, causing instant death.
186     // This behaviour seems to be conformant with IEEE Std 1003.1-2001.
187     // Let's just use the underlying Mach Microkernel calls directly,
188     // they're much nicer.
189     
190     kern_return_t err;
191     ret = addr;
192     if(addr)    // try to allocate at adress
193         err = vm_allocate(mach_task_self(),(vm_address_t*) &ret, size, FALSE);
194     if(!addr || err)    // try to allocate anywhere
195         err = vm_allocate(mach_task_self(),(vm_address_t*) &ret, size, TRUE);
196         
197     if(err) {
198         // don't know what the error codes mean exactly, assume it's
199         // not our problem though.
200         errorBelch("memory allocation failed (requested %lu bytes)", size);
201         stg_exit(EXIT_FAILURE);
202     } else {
203         vm_protect(mach_task_self(),ret,size,FALSE,VM_PROT_READ|VM_PROT_WRITE);
204     }
205 #else
206     ret = mmap(addr, size, PROT_READ | PROT_WRITE | PROT_EXEC, 
207                MAP_ANON | MAP_PRIVATE, -1, 0);
208 #endif
209
210     if (ret == (void *)-1) {
211         if (errno == ENOMEM || 
212             (errno == EINVAL && sizeof(void*)==4 && size >= 0xc0000000)) {
213             // If we request more than 3Gig, then we get EINVAL
214             // instead of ENOMEM (at least on Linux).
215             errorBelch("out of memory (requested %lu bytes)", size);
216             stg_exit(EXIT_FAILURE);
217         } else {
218             barf("getMBlock: mmap: %s", strerror(errno));
219         }
220     }
221
222     return ret;
223 }
224
225 // Implements the general case: allocate a chunk of memory of 'size'
226 // mblocks.
227
228 static void *
229 gen_map_mblocks (lnat size)
230 {
231     int slop;
232     void *ret;
233
234     // Try to map a larger block, and take the aligned portion from
235     // it (unmap the rest).
236     size += MBLOCK_SIZE;
237     ret = my_mmap(0, size);
238     
239     // unmap the slop bits around the chunk we allocated
240     slop = (W_)ret & MBLOCK_MASK;
241     
242     if (munmap(ret, MBLOCK_SIZE - slop) == -1) {
243       barf("gen_map_mblocks: munmap failed");
244     }
245     if (slop > 0 && munmap(ret+size-slop, slop) == -1) {
246       barf("gen_map_mblocks: munmap failed");
247     }
248
249     // ToDo: if we happened to get an aligned block, then don't
250     // unmap the excess, just use it. For this to work, you
251     // need to keep in mind the following:
252     //     * Calling my_mmap() with an 'addr' arg pointing to
253     //       already my_mmap()ed space is OK and won't fail.
254     //     * If my_mmap() can't satisfy the request at the
255     //       given 'next_request' address in getMBlocks(), that
256     //       you unmap the extra mblock mmap()ed here (or simply
257     //       satisfy yourself that the slop introduced isn't worth
258     //       salvaging.)
259     // 
260
261     // next time, try after the block we just got.
262     ret += MBLOCK_SIZE - slop;
263     return ret;
264 }
265
266
267 // The external interface: allocate 'n' mblocks, and return the
268 // address.
269
270 void *
271 getMBlocks(nat n)
272 {
273   caddr_t ret;
274   lnat size = MBLOCK_SIZE * n;
275   nat i;
276  
277   if (next_request == 0) {
278       // use gen_map_mblocks the first time.
279       ret = gen_map_mblocks(size);
280   } else {
281       ret = my_mmap(next_request, size);
282
283       if (((W_)ret & MBLOCK_MASK) != 0) {
284           // misaligned block!
285 #if 0 // defined(DEBUG)
286           errorBelch("warning: getMBlock: misaligned block %p returned when allocating %d megablock(s) at %p", ret, n, next_request);
287 #endif
288
289           // unmap this block...
290           if (munmap(ret, size) == -1) {
291               barf("getMBlock: munmap failed");
292           }
293           // and do it the hard way
294           ret = gen_map_mblocks(size);
295       }
296   }
297
298   // Next time, we'll try to allocate right after the block we just got.
299   // ToDo: check that we haven't already grabbed the memory at next_request
300   next_request = ret + size;
301
302   debugTrace(DEBUG_gc, "allocated %d megablock(s) at %p",n,ret);
303
304   // fill in the table
305   for (i = 0; i < n; i++) {
306       markHeapAlloced( ret + i * MBLOCK_SIZE );
307   }
308
309   mblocks_allocated += n;
310
311   return ret;
312 }
313
314 void
315 freeAllMBlocks(void)
316 {
317   /* XXX Do something here */
318 }
319
320 #else /* defined(mingw32_HOST_OS) || defined(cygwin32_HOST_OS) */
321
322 /* alloc_rec keeps the info we need to have matching VirtualAlloc and
323    VirtualFree calls.
324 */
325 typedef struct alloc_rec_ {
326     char* base;     /* non-aligned base address, directly from VirtualAlloc */
327     int size;       /* Size in bytes */
328     struct alloc_rec_* next;
329 } alloc_rec;
330
331 typedef struct block_rec_ {
332     char* base;         /* base address, non-MBLOCK-aligned */
333     int size;           /* size in bytes */
334     struct block_rec_* next;
335 } block_rec;
336
337 static alloc_rec* allocs = 0;
338 static block_rec* free_blocks = 0;
339
340 static
341 alloc_rec*
342 allocNew(nat n) {
343     alloc_rec* rec;
344     rec = (alloc_rec*)stgMallocBytes(sizeof(alloc_rec),"getMBlocks: allocNew");
345     rec->size = (n+1)*MBLOCK_SIZE;
346     rec->base = 
347         VirtualAlloc(NULL, rec->size, MEM_RESERVE, PAGE_READWRITE);
348     if(rec->base==0) {
349         stgFree((void*)rec);
350         rec=0;
351         sysErrorBelch(
352             "getMBlocks: VirtualAlloc MEM_RESERVE %d blocks failed", n);
353     } else {
354                 alloc_rec temp;
355                 temp.base=0; temp.size=0; temp.next=allocs;
356
357         alloc_rec* it;
358         it=&temp;
359         for(; it->next!=0 && it->next->base<rec->base; it=it->next) ;
360         rec->next=it->next;
361         it->next=rec;
362
363                 allocs=temp.next;
364         debugTrace(DEBUG_gc, "allocated %d megablock(s) at 0x%x",n,(nat)rec->base);
365     }
366     return rec;
367 }
368
369 static
370 void
371 insertFree(char* alloc_base, int alloc_size) {
372     block_rec temp;
373     block_rec* it;
374     block_rec* prev;
375
376     temp.base=0; temp.size=0; temp.next=free_blocks;
377     it = free_blocks;
378     prev = &temp;
379     for( ; it!=0 && it->base<alloc_base; prev=it, it=it->next) {}
380
381     if(it!=0 && alloc_base+alloc_size == it->base) {
382         if(prev->base + prev->size == alloc_base) {        /* Merge it, alloc, prev */
383             prev->size += alloc_size + it->size;
384             prev->next = it->next;
385             stgFree(it);
386         } else {                                            /* Merge it, alloc */
387             it->base = alloc_base;
388             it->size += alloc_size;
389         }
390     } else if(prev->base + prev->size == alloc_base) {     /* Merge alloc, prev */
391         prev->size += alloc_size;
392     } else {                                                /* Merge none */
393         block_rec* rec;
394         rec = (block_rec*)stgMallocBytes(sizeof(block_rec),"getMBlocks: insertFree");
395         rec->base=alloc_base;
396         rec->size=alloc_size;
397         rec->next = it;
398         prev->next=rec;
399     }
400     free_blocks=temp.next;
401 }
402
403 static
404 void*
405 findFreeBlocks(nat n) {
406     void* ret=0;
407     block_rec* it;
408     block_rec temp;
409     block_rec* prev;
410
411     int required_size;
412     it=free_blocks;
413     required_size = n*MBLOCK_SIZE;
414     temp.next=free_blocks; temp.base=0; temp.size=0;
415     prev=&temp;
416     /* TODO: Don't just take first block, find smallest sufficient block */
417     for( ; it!=0 && it->size<required_size; prev=it, it=it->next ) {}
418     if(it!=0) {
419         if( (((unsigned long)it->base) & MBLOCK_MASK) == 0) { /* MBlock aligned */
420             ret = (void*)it->base;
421             if(it->size==required_size) {
422                 prev->next=it->next;
423                 stgFree(it);
424             } else {
425                 it->base += required_size;
426                 it->size -=required_size;
427             }
428         } else {
429             char* need_base;
430             block_rec* next;
431             int new_size;
432             need_base = (char*)(((unsigned long)it->base) & ((unsigned long)~MBLOCK_MASK)) + MBLOCK_SIZE;
433             next = (block_rec*)stgMallocBytes(
434                     sizeof(block_rec)
435                     , "getMBlocks: findFreeBlocks: splitting");
436             new_size = need_base - it->base;
437             next->base = need_base +required_size;
438             next->size = it->size - (new_size+required_size);
439             it->size = new_size;
440             next->next = it->next;
441             it->next = next;
442             ret=(void*)need_base;
443         }
444     }
445     free_blocks=temp.next;
446     return ret;
447 }
448
449 /* VirtualAlloc MEM_COMMIT can't cross boundaries of VirtualAlloc MEM_RESERVE,
450    so we might need to do many VirtualAlloc MEM_COMMITs.  We simply walk the
451    (ordered) allocated blocks. */
452 static void
453 commitBlocks(char* base, int size) {
454     alloc_rec* it;
455     it=allocs;
456     for( ; it!=0 && (it->base+it->size)<=base; it=it->next ) {}
457     for( ; it!=0 && size>0; it=it->next ) {
458         int size_delta;
459         void* temp;
460         size_delta = it->size - (base-it->base);
461         if(size_delta>size) size_delta=size;
462         temp = VirtualAlloc(base, size_delta, MEM_COMMIT, PAGE_READWRITE);
463         if(temp==0) {
464             sysErrorBelch("getMBlocks: VirtualAlloc MEM_COMMIT failed");
465             stg_exit(EXIT_FAILURE);
466         }
467         size-=size_delta;
468         base+=size_delta;
469     }
470 }
471
472 void *
473 getMBlocks(nat n) {
474     void* ret;
475     ret = findFreeBlocks(n);
476     if(ret==0) {
477         alloc_rec* alloc;
478         alloc = allocNew(n);
479         /* We already belch in allocNew if it fails */
480         if (alloc == 0) {
481             stg_exit(EXIT_FAILURE);
482         } else {
483             insertFree(alloc->base, alloc->size);
484             ret = findFreeBlocks(n);
485         }
486     }
487
488     if(ret!=0) {
489         /* (In)sanity tests */
490         if (((W_)ret & MBLOCK_MASK) != 0) {
491             barf("getMBlocks: misaligned block returned");
492         }
493
494         commitBlocks(ret, MBLOCK_SIZE*n);
495
496         /* Global bookkeeping */
497         mblocks_allocated += n;
498         int i;
499         for(i=0; i<(int)n; ++i) {
500             markHeapAlloced( ret + i * MBLOCK_SIZE );
501         }
502     }
503
504     return ret;
505 }
506
507 void
508 freeAllMBlocks(void)
509 {
510     {
511         block_rec* next;
512         block_rec* it;
513         next=0;
514         it = free_blocks;
515         for(; it!=0; ) {
516             next = it->next;
517             stgFree(it);
518             it=next;
519         }
520     }
521     {
522         alloc_rec* next;
523         alloc_rec* it;
524         next=0;
525         it=allocs;
526         for(; it!=0; ) {
527             if(!VirtualFree((void*)it->base, 0, MEM_RELEASE)) {
528                 sysErrorBelch("freeAllMBlocks: VirtualFree MEM_RELEASE failed");
529                 stg_exit(EXIT_FAILURE);
530             }
531             next = it->next;
532             stgFree(it);
533             it=next;
534         }
535     }
536 }
537
538 #endif