[project @ 2000-01-22 12:06:43 by simonmar]
[ghc-hetmet.git] / ghc / rts / MBlock.c
1 /* -----------------------------------------------------------------------------
2  * $Id: MBlock.c,v 1.14 2000/01/22 12:06:43 simonmar Exp $
3  *
4  * (c) The GHC Team 1998-1999
5  *
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.
9  *
10  * ---------------------------------------------------------------------------*/
11
12 #define NON_POSIX_SOURCE
13
14 #include "Rts.h"
15 #include "RtsUtils.h"
16 #include "RtsFlags.h"
17 #include "MBlock.h"
18 #include "BlockAlloc.h"
19
20 #ifdef HAVE_UNISTD_H
21 #include <unistd.h>
22 #endif
23
24 #ifdef HAVE_SYS_TYPES_H
25 #include <sys/types.h>
26 #endif
27
28 #ifndef mingw32_TARGET_OS
29 # ifdef HAVE_SYS_MMAN_H
30 # include <sys/mman.h>
31 # endif
32 #endif
33
34 #ifdef HAVE_FCNTL_H
35 #include <fcntl.h>
36 #endif
37
38 #if HAVE_WINDOWS_H
39 #include <windows.h>
40 #endif
41
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.
47  */
48 #define ASK_FOR_MEM_AT 0x50000000
49
50 #elif netbsd_TARGET_OS
51 /* NetBSD i386 shared libs are at 0x40000000
52  */
53 #define ASK_FOR_MEM_AT 0x50000000
54 #elif linux_TARGET_OS
55 /* Any ideas?
56  */
57 #define ASK_FOR_MEM_AT 0x50000000
58
59 #elif solaris2_TARGET_OS
60 /* guess */
61 #define ASK_FOR_MEM_AT 0x50000000
62
63 #elif osf3_TARGET_OS
64 /* guess */
65 #define ASK_FOR_MEM_AT 0x50000000
66
67 #elif hpux_TARGET_OS
68 /* guess */
69 #define ASK_FOR_MEM_AT 0x50000000
70
71 #elif _WIN32
72 /* doesn't matter, we use a reserve/commit algorithm */
73
74 #else
75 #error Dont know where to get memory from on this architecture
76 /* ToDo: memory locations on other architectures */
77 #endif
78
79 lnat mblocks_allocated = 0;
80
81 void *
82 getMBlock(void)
83 {
84   return getMBlocks(1);
85 }
86
87 #ifndef _WIN32
88 void *
89 getMBlocks(nat n)
90 {
91   static caddr_t next_request = (caddr_t)ASK_FOR_MEM_AT;
92   caddr_t ret;
93   lnat size = MBLOCK_SIZE * n;
94  
95 #ifdef solaris2_TARGET_OS
96   { 
97       int fd = open("/dev/zero",O_RDONLY);
98       ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
99                  MAP_FIXED | MAP_PRIVATE, fd, 0);
100       close(fd);
101   }
102 #elif hpux_TARGET_OS
103  ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
104              MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
105 #else
106   ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
107              MAP_ANON | MAP_PRIVATE, -1, 0);
108 #endif
109   
110   if (ret == (void *)-1) {
111     if (errno == ENOMEM) {
112       barf("getMBlock: out of memory");
113     } else {
114       barf("GetMBlock: mmap failed");
115     }
116   }
117
118   if (((W_)ret & MBLOCK_MASK) != 0) {
119     barf("GetMBlock: misaligned block returned");
120   }
121
122   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
123
124   next_request += size;
125
126   mblocks_allocated += n;
127   
128   return ret;
129 }
130
131 #else /* _WIN32 */
132
133 /*
134  On Win32 platforms we make use of the two-phased virtual memory API
135  to allocate mega blocks. We proceed as follows:
136
137  Reserve a large chunk of VM (128M at the time), but don't supply a 
138  base address that's aligned on a MB boundary. Instead we round up to the
139  nearest from the chunk of VM we're given back from the OS (at the
140  moment we just leave the 'slop' at the beginning of the reserved
141  chunk unused - ToDo: reuse it .)
142
143  Reserving memory doesn't allocate physical storage (not even in the
144  page file), this is done by committing pages (or mega-blocks in
145  our case).
146
147 */
148
149 char* base_non_committed = (char*)0;
150
151 /* Reserve VM 128M at the time to try to minimise the slop cost. */
152 #define SIZE_RESERVED_POOL  ( 128 * 1024 * 1024 )
153
154 /* This predicate should be inlined, really. */
155 int
156 is_heap_alloced(const void* x)
157 {
158   return (((char*)(x) >= base_non_committed) && 
159           ((char*)(x) <= (base_non_committed + 128 * 1024 * 1024)));
160 }
161
162 void *
163 getMBlocks(nat n)
164 {
165   static char* base_mblocks       = (char*)0;
166   static char* next_request       = (char*)0;
167   void* ret                       = (void*)0;
168
169   lnat size = MBLOCK_SIZE * n;
170
171   if ( (base_non_committed == 0) || 
172        (next_request + size > base_non_committed + SIZE_RESERVED_POOL) ) {
173     base_non_committed = VirtualAlloc ( NULL
174                                       , SIZE_RESERVED_POOL
175                                       , MEM_RESERVE
176                                       , PAGE_READWRITE
177                                       );
178     if ( base_non_committed == 0 ) {
179 # if 1 /*def DEBUG*/
180          fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
181 # endif
182          ret=(void*)-1;
183     } else {
184     /* The returned pointer is not aligned on a mega-block boundary. Make it. */
185        base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)0xfff00000) + MBLOCK_SIZE;
186 # if 0
187        fprintf(stderr, "Dropping %d bytes off of 128M chunk\n", 
188                        (unsigned)base_mblocks - (unsigned)base_non_committed);
189 # endif
190
191        if ( ((char*)base_mblocks + size) > ((char*)base_non_committed + SIZE_RESERVED_POOL) ) {
192 # if 1 /*def DEBUG*/
193           fprintf(stderr, "oops, committed too small a region to start with.");
194 # endif
195           ret=(void*)-1;
196        } else {
197           next_request = base_mblocks;
198        }
199     }
200   }
201   /* Commit the mega block(s) to phys mem */
202   if ( ret != (void*)-1 ) {
203      ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
204      if (ret == NULL) {
205 # if 1 /*def DEBUG*/
206         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
207 # endif
208         ret=(void*)-1;
209      }
210   }
211
212   if (((W_)ret & MBLOCK_MASK) != 0) {
213     barf("GetMBlock: misaligned block returned");
214   }
215
216   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
217
218   next_request = (char*)next_request + size;
219
220   mblocks_allocated += n;
221   
222   return ret;
223 }
224
225 /* Hand back the physical memory that is allocated to a mega-block. 
226    ToDo: chain the released mega block onto some list so that
227          getMBlocks() can get at it.
228
229    Currently unused.
230 */
231 #if 0
232 void
233 freeMBlock(void* p, nat n)
234 {
235   BOOL rc;
236
237   rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
238   
239   if (rc == FALSE) {
240 # ifdef DEBUG
241      fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
242 # endif
243   }
244
245 }
246 #endif
247
248 #endif