[project @ 2000-08-17 15:21:55 by rrt]
[ghc-hetmet.git] / ghc / rts / MBlock.c
1 /* -----------------------------------------------------------------------------
2  * $Id: MBlock.c,v 1.17 2000/08/17 15:21:55 rrt 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 openbsd_TARGET_OS
55 #define ASK_FOR_MEM_AT 0x50000000
56 #elif linux_TARGET_OS
57 /* Any ideas?
58  */
59 #define ASK_FOR_MEM_AT 0x50000000
60
61 #elif solaris2_TARGET_OS
62 /* guess */
63 #define ASK_FOR_MEM_AT 0x50000000
64
65 #elif osf3_TARGET_OS
66 /* guess */
67 #define ASK_FOR_MEM_AT 0x50000000
68
69 #elif hpux_TARGET_OS
70 /* guess */
71 #define ASK_FOR_MEM_AT 0x50000000
72
73 #elif _WIN32
74 /* doesn't matter, we use a reserve/commit algorithm */
75
76 #else
77 #error Dont know where to get memory from on this architecture
78 /* ToDo: memory locations on other architectures */
79 #endif
80
81 lnat mblocks_allocated = 0;
82
83 void *
84 getMBlock(void)
85 {
86   return getMBlocks(1);
87 }
88
89 #ifndef _WIN32
90 void *
91 getMBlocks(nat n)
92 {
93   static caddr_t next_request = (caddr_t)ASK_FOR_MEM_AT;
94   caddr_t ret;
95   lnat size = MBLOCK_SIZE * n;
96  
97 #ifdef solaris2_TARGET_OS
98   { 
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);
102       close(fd);
103   }
104 #elif hpux_TARGET_OS
105  ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
106              MAP_ANONYMOUS | MAP_PRIVATE, -1, 0);
107 #else
108   ret = mmap(next_request, size, PROT_READ | PROT_WRITE, 
109              MAP_ANON | MAP_PRIVATE, -1, 0);
110 #endif
111   
112   if (ret == (void *)-1) {
113     if (errno == ENOMEM) {
114       barf("getMBlock: out of memory");
115     } else {
116       barf("GetMBlock: mmap failed");
117     }
118   }
119
120   if (((W_)ret & MBLOCK_MASK) != 0) {
121     barf("GetMBlock: misaligned block returned");
122   }
123
124   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
125
126   next_request += size;
127
128   mblocks_allocated += n;
129   
130   return ret;
131 }
132
133 #else /* _WIN32 */
134
135 /*
136  On Win32 platforms we make use of the two-phased virtual memory API
137  to allocate mega blocks. We proceed as follows:
138
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 .)
144
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
147  our case).
148
149 */
150
151 char* base_non_committed = (char*)0;
152
153 /* Reserve VM 128M at the time to try to minimise the slop cost. */
154 #define SIZE_RESERVED_POOL  ( 128 * 1024 * 1024 )
155
156 /* This predicate should be inlined, really. */
157 /* TODO: this only works for a single chunk */
158 int
159 is_heap_alloced(const void* x)
160 {
161   return (((char*)(x) >= base_non_committed) && 
162           ((char*)(x) <= (base_non_committed + SIZE_RESERVED_POOL)));
163 }
164
165 void *
166 getMBlocks(nat n)
167 {
168   static char* base_mblocks       = (char*)0;
169   static char* next_request       = (char*)0;
170   void* ret                       = (void*)0;
171
172   lnat size = MBLOCK_SIZE * n;
173
174   if ( (base_non_committed == 0) || 
175        (next_request + size > base_non_committed + SIZE_RESERVED_POOL) ) {
176 #ifdef ENABLE_WIN32_DLL_SUPPORT
177     barf("2nd Windows monster block required; I can only cope with 1!");
178 #endif
179     base_non_committed = VirtualAlloc ( NULL
180                                       , SIZE_RESERVED_POOL
181                                       , MEM_RESERVE
182                                       , PAGE_READWRITE
183                                       );
184     if ( base_non_committed == 0 ) {
185 # if 1 /*def DEBUG*/
186          fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
187 # endif
188          ret=(void*)-1;
189     } else {
190     /* The returned pointer is not aligned on a mega-block boundary. Make it. */
191        base_mblocks = (char*)((unsigned long)base_non_committed & (unsigned long)0xfff00000) + MBLOCK_SIZE;
192 # if 0
193        fprintf(stderr, "Dropping %d bytes off of 128M chunk\n", 
194                        (unsigned)base_mblocks - (unsigned)base_non_committed);
195 # endif
196
197        if ( ((char*)base_mblocks + size) > ((char*)base_non_committed + SIZE_RESERVED_POOL) ) {
198 # if 1 /*def DEBUG*/
199           fprintf(stderr, "oops, committed too small a region to start with.");
200 # endif
201           ret=(void*)-1;
202        } else {
203           next_request = base_mblocks;
204        }
205     }
206   }
207   /* Commit the mega block(s) to phys mem */
208   if ( ret != (void*)-1 ) {
209      ret = VirtualAlloc(next_request, size, MEM_COMMIT, PAGE_READWRITE);
210      if (ret == NULL) {
211 # if 1 /*def DEBUG*/
212         fprintf(stderr, "getMBlocks: VirtualAlloc failed with: %d\n", GetLastError());
213 # endif
214         ret=(void*)-1;
215      }
216   }
217
218   if (((W_)ret & MBLOCK_MASK) != 0) {
219     barf("GetMBlock: misaligned block returned");
220   }
221
222   IF_DEBUG(gc,fprintf(stderr,"Allocated %d megablock(s) at %x\n",n,(nat)ret));
223
224   next_request = (char*)next_request + size;
225
226   mblocks_allocated += n;
227   
228   return ret;
229 }
230
231 /* Hand back the physical memory that is allocated to a mega-block. 
232    ToDo: chain the released mega block onto some list so that
233          getMBlocks() can get at it.
234
235    Currently unused.
236 */
237 #if 0
238 void
239 freeMBlock(void* p, nat n)
240 {
241   BOOL rc;
242
243   rc = VirtualFree(p, n * MBLOCK_SIZE , MEM_DECOMMIT );
244   
245   if (rc == FALSE) {
246 # ifdef DEBUG
247      fprintf(stderr, "freeMBlocks: VirtualFree failed with: %d\n", GetLastError());
248 # endif
249   }
250
251 }
252 #endif
253
254 #endif