Fix AnnDotDot in module export
[ghc.git] / rts / win32 / OSMem.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The University of Glasgow 2006-2007
4 *
5 * OS-specific memory management
6 *
7 * ---------------------------------------------------------------------------*/
8
9 #include "Rts.h"
10 #include "sm/OSMem.h"
11 #include "sm/HeapAlloc.h"
12 #include "RtsUtils.h"
13
14 #if HAVE_WINDOWS_H
15 #include <windows.h>
16 #endif
17
18 typedef struct alloc_rec_ {
19 char* base; // non-aligned base address, directly from VirtualAlloc
20 W_ size; // Size in bytes
21 struct alloc_rec_* next;
22 } alloc_rec;
23
24 typedef struct block_rec_ {
25 char* base; // base address, non-MBLOCK-aligned
26 W_ size; // size in bytes
27 struct block_rec_* next;
28 } block_rec;
29
30 /* allocs are kept in ascending order, and are the memory regions as
31 returned by the OS as we need to have matching VirtualAlloc and
32 VirtualFree calls.
33
34 If USE_LARGE_ADDRESS_SPACE is defined, this list will contain only
35 one element.
36 */
37 static alloc_rec* allocs = NULL;
38
39 /* free_blocks are kept in ascending order, and adjacent blocks are merged */
40 static block_rec* free_blocks = NULL;
41
42 void
43 osMemInit(void)
44 {
45 allocs = NULL;
46 free_blocks = NULL;
47 }
48
49 static
50 alloc_rec*
51 allocNew(nat n) {
52 alloc_rec* rec;
53 rec = (alloc_rec*)stgMallocBytes(sizeof(alloc_rec),"getMBlocks: allocNew");
54 rec->size = ((W_)n+1)*MBLOCK_SIZE;
55 rec->base =
56 VirtualAlloc(NULL, rec->size, MEM_RESERVE, PAGE_READWRITE);
57 if(rec->base==0) {
58 stgFree((void*)rec);
59 rec=0;
60 if (GetLastError() == ERROR_NOT_ENOUGH_MEMORY) {
61
62 errorBelch("out of memory");
63 } else {
64 sysErrorBelch(
65 "getMBlocks: VirtualAlloc MEM_RESERVE %d blocks failed", n);
66 }
67 } else {
68 alloc_rec temp;
69 temp.base=0; temp.size=0; temp.next=allocs;
70
71 alloc_rec* it;
72 it=&temp;
73 for(; it->next!=0 && it->next->base<rec->base; it=it->next) ;
74 rec->next=it->next;
75 it->next=rec;
76
77 allocs=temp.next;
78 }
79 return rec;
80 }
81
82 static
83 void
84 insertFree(char* alloc_base, W_ alloc_size) {
85 block_rec temp;
86 block_rec* it;
87 block_rec* prev;
88
89 temp.base=0; temp.size=0; temp.next=free_blocks;
90 it = free_blocks;
91 prev = &temp;
92 for( ; it!=0 && it->base<alloc_base; prev=it, it=it->next) {}
93
94 if(it!=0 && alloc_base+alloc_size == it->base) {
95 if(prev->base + prev->size == alloc_base) { /* Merge it, alloc, prev */
96 prev->size += alloc_size + it->size;
97 prev->next = it->next;
98 stgFree(it);
99 } else { /* Merge it, alloc */
100 it->base = alloc_base;
101 it->size += alloc_size;
102 }
103 } else if(prev->base + prev->size == alloc_base) { /* Merge alloc, prev */
104 prev->size += alloc_size;
105 } else { /* Merge none */
106 block_rec* rec;
107 rec = (block_rec*)stgMallocBytes(sizeof(block_rec),
108 "getMBlocks: insertFree");
109 rec->base=alloc_base;
110 rec->size=alloc_size;
111 rec->next = it;
112 prev->next=rec;
113 }
114 free_blocks=temp.next;
115 }
116
117 static
118 void*
119 findFreeBlocks(nat n) {
120 void* ret=0;
121 block_rec* it;
122 block_rec temp;
123 block_rec* prev;
124
125 W_ required_size;
126 it=free_blocks;
127 required_size = n*MBLOCK_SIZE;
128 temp.next=free_blocks; temp.base=0; temp.size=0;
129 prev=&temp;
130 /* TODO: Don't just take first block, find smallest sufficient block */
131 for( ; it!=0 && it->size<required_size; prev=it, it=it->next ) {}
132 if(it!=0) {
133 if( (((W_)it->base) & MBLOCK_MASK) == 0) { /* MBlock aligned */
134 ret = (void*)it->base;
135 if(it->size==required_size) {
136 prev->next=it->next;
137 stgFree(it);
138 } else {
139 it->base += required_size;
140 it->size -=required_size;
141 }
142 } else {
143 char* need_base;
144 block_rec* next;
145 int new_size;
146 need_base =
147 (char*)(((W_)it->base) & ((W_)~MBLOCK_MASK)) + MBLOCK_SIZE;
148 next = (block_rec*)stgMallocBytes(
149 sizeof(block_rec)
150 , "getMBlocks: findFreeBlocks: splitting");
151 new_size = need_base - it->base;
152 next->base = need_base +required_size;
153 next->size = it->size - (new_size+required_size);
154 it->size = new_size;
155 next->next = it->next;
156 it->next = next;
157 ret=(void*)need_base;
158 }
159 }
160 free_blocks=temp.next;
161 return ret;
162 }
163
164 /* VirtualAlloc MEM_COMMIT can't cross boundaries of VirtualAlloc MEM_RESERVE,
165 so we might need to do many VirtualAlloc MEM_COMMITs. We simply walk the
166 (ordered) allocated blocks. */
167 static void
168 commitBlocks(char* base, W_ size) {
169 alloc_rec* it;
170 it=allocs;
171 for( ; it!=0 && (it->base+it->size)<=base; it=it->next ) {}
172 for( ; it!=0 && size>0; it=it->next ) {
173 W_ size_delta;
174 void* temp;
175 size_delta = it->size - (base-it->base);
176 if(size_delta>size) size_delta=size;
177 temp = VirtualAlloc(base, size_delta, MEM_COMMIT, PAGE_READWRITE);
178 if(temp==0) {
179 sysErrorBelch("getMBlocks: VirtualAlloc MEM_COMMIT failed");
180 stg_exit(EXIT_FAILURE);
181 }
182 size-=size_delta;
183 base+=size_delta;
184 }
185 }
186
187 void *
188 osGetMBlocks(nat n) {
189 void* ret;
190 ret = findFreeBlocks(n);
191 if(ret==0) {
192 alloc_rec* alloc;
193 alloc = allocNew(n);
194 /* We already belch in allocNew if it fails */
195 if (alloc == 0) {
196 stg_exit(EXIT_FAILURE);
197 } else {
198 insertFree(alloc->base, alloc->size);
199 ret = findFreeBlocks(n);
200 }
201 }
202
203 if(ret!=0) {
204 /* (In)sanity tests */
205 if (((W_)ret & MBLOCK_MASK) != 0) {
206 barf("getMBlocks: misaligned block returned");
207 }
208
209 commitBlocks(ret, (W_)MBLOCK_SIZE*n);
210 }
211
212 return ret;
213 }
214
215 static void decommitBlocks(char *addr, W_ nBytes)
216 {
217 alloc_rec *p;
218
219 p = allocs;
220 while ((p != NULL) && (addr >= (p->base + p->size))) {
221 p = p->next;
222 }
223 while (nBytes > 0) {
224 if ((p == NULL) || (p->base > addr)) {
225 errorBelch("Memory to be freed isn't allocated\n");
226 stg_exit(EXIT_FAILURE);
227 }
228 if (p->base + p->size >= addr + nBytes) {
229 if (!VirtualFree(addr, nBytes, MEM_DECOMMIT)) {
230 sysErrorBelch("osFreeMBlocks: VirtualFree MEM_DECOMMIT failed");
231 stg_exit(EXIT_FAILURE);
232 }
233 nBytes = 0;
234 }
235 else {
236 W_ bytesToFree = p->base + p->size - addr;
237 if (!VirtualFree(addr, bytesToFree, MEM_DECOMMIT)) {
238 sysErrorBelch("osFreeMBlocks: VirtualFree MEM_DECOMMIT failed");
239 stg_exit(EXIT_FAILURE);
240 }
241 addr += bytesToFree;
242 nBytes -= bytesToFree;
243 p = p->next;
244 }
245 }
246 }
247
248 void osFreeMBlocks(char *addr, nat n)
249 {
250 W_ nBytes = (W_)n * MBLOCK_SIZE;
251
252 insertFree(addr, nBytes);
253 decommitBlocks(addr, nBytes);
254 }
255
256 void osReleaseFreeMemory(void)
257 {
258 alloc_rec *prev_a, *a;
259 alloc_rec head_a;
260 block_rec *prev_fb, *fb;
261 block_rec head_fb;
262 char *a_end, *fb_end;
263
264 /* go through allocs and free_blocks in lockstep, looking for allocs
265 that are completely free, and uncommit them */
266
267 head_a.base = 0;
268 head_a.size = 0;
269 head_a.next = allocs;
270 head_fb.base = 0;
271 head_fb.size = 0;
272 head_fb.next = free_blocks;
273 prev_a = &head_a;
274 a = allocs;
275 prev_fb = &head_fb;
276 fb = free_blocks;
277
278 while (a != NULL) {
279 a_end = a->base + a->size;
280 /* If a is freeable then there is a single freeblock in fb that
281 covers it. The end of this free block must be >= the end of
282 a, so skip anything in fb that ends before a. */
283 while (fb != NULL && fb->base + fb->size < a_end) {
284 prev_fb = fb;
285 fb = fb->next;
286 }
287
288 if (fb == NULL) {
289 /* If we have nothing left in fb, then neither a nor
290 anything later in the list is freeable, so we are done. */
291 break;
292 }
293 else {
294 fb_end = fb->base + fb->size;
295 /* We have a candidate fb. But does it really cover a? */
296 if (fb->base <= a->base) {
297 /* Yes, the alloc is within the free block. Now we need
298 to know if it sticks out at either end. */
299 if (fb_end == a_end) {
300 if (fb->base == a->base) {
301 /* fb and a are identical, so just free fb */
302 prev_fb->next = fb->next;
303 stgFree(fb);
304 fb = prev_fb->next;
305 }
306 else {
307 /* fb begins earlier, so truncate it to not include a */
308 fb->size = a->base - fb->base;
309 }
310 }
311 else {
312 /* fb ends later, so we'll make fb just be the part
313 after a. First though, if it also starts earlier,
314 we make a new free block record for the before bit. */
315 if (fb->base != a->base) {
316 block_rec *new_fb;
317
318 new_fb =
319 (block_rec *)stgMallocBytes(sizeof(block_rec),
320 "osReleaseFreeMemory");
321 new_fb->base = fb->base;
322 new_fb->size = a->base - fb->base;
323 new_fb->next = fb;
324 prev_fb->next = new_fb;
325 }
326 fb->size = fb_end - a_end;
327 fb->base = a_end;
328 }
329 /* Now we can free the alloc */
330 prev_a->next = a->next;
331 if(!VirtualFree((void *)a->base, 0, MEM_RELEASE)) {
332 sysErrorBelch("freeAllMBlocks: VirtualFree MEM_RELEASE "
333 "failed");
334 stg_exit(EXIT_FAILURE);
335 }
336 stgFree(a);
337 a = prev_a->next;
338 }
339 else {
340 /* Otherwise this alloc is not freeable, so go on to the
341 next one */
342 prev_a = a;
343 a = a->next;
344 }
345 }
346 }
347
348 allocs = head_a.next;
349 free_blocks = head_fb.next;
350 }
351
352 void
353 osFreeAllMBlocks(void)
354 {
355 {
356 block_rec* next;
357 block_rec* it;
358 next=0;
359 it = free_blocks;
360 for(; it!=0; ) {
361 next = it->next;
362 stgFree(it);
363 it=next;
364 }
365 }
366 {
367 alloc_rec* next;
368 alloc_rec* it;
369 next=0;
370 it=allocs;
371 for(; it!=0; ) {
372 if(!VirtualFree((void*)it->base, 0, MEM_RELEASE)) {
373 sysErrorBelch("freeAllMBlocks: VirtualFree MEM_RELEASE failed");
374 stg_exit(EXIT_FAILURE);
375 }
376 next = it->next;
377 stgFree(it);
378 it=next;
379 }
380 }
381 }
382
383 W_ getPageSize (void)
384 {
385 static W_ pagesize = 0;
386 if (pagesize) {
387 return pagesize;
388 } else {
389 SYSTEM_INFO sSysInfo;
390 GetSystemInfo(&sSysInfo);
391 pagesize = sSysInfo.dwPageSize;
392 return pagesize;
393 }
394 }
395
396 /* Returns 0 if physical memory size cannot be identified */
397 StgWord64 getPhysicalMemorySize (void)
398 {
399 static StgWord64 physMemSize = 0;
400 if (!physMemSize) {
401 MEMORYSTATUSEX status;
402 status.dwLength = sizeof(status);
403 if (!GlobalMemoryStatusEx(&status)) {
404 #if defined(DEBUG)
405 errorBelch("warning: getPhysicalMemorySize: cannot get physical "
406 "memory size");
407 #endif
408 return 0;
409 }
410 physMemSize = status.ullTotalPhys;
411 }
412 return physMemSize;
413 }
414
415 void setExecutable (void *p, W_ len, rtsBool exec)
416 {
417 DWORD dwOldProtect = 0;
418 if (VirtualProtect (p, len,
419 exec ? PAGE_EXECUTE_READWRITE : PAGE_READWRITE,
420 &dwOldProtect) == 0)
421 {
422 sysErrorBelch("setExecutable: failed to protect 0x%p; old protection: "
423 "%lu\n", p, (unsigned long)dwOldProtect);
424 stg_exit(EXIT_FAILURE);
425 }
426 }
427
428 #ifdef USE_LARGE_ADDRESS_SPACE
429
430 static void* heap_base = NULL;
431
432 void *osReserveHeapMemory (W_ *len)
433 {
434 void *start;
435
436 heap_base = VirtualAlloc(NULL, *len + MBLOCK_SIZE,
437 MEM_RESERVE, PAGE_READWRITE);
438 if (heap_base == NULL) {
439 if (GetLastError() == ERROR_NOT_ENOUGH_MEMORY) {
440 errorBelch("out of memory");
441 } else {
442 sysErrorBelch(
443 "osReserveHeapMemory: VirtualAlloc MEM_RESERVE %llu bytes failed",
444 len + MBLOCK_SIZE);
445 }
446 stg_exit(EXIT_FAILURE);
447 }
448
449 // VirtualFree MEM_RELEASE must always match a
450 // previous MEM_RESERVE call, in address and size
451 // so we necessarily leak some address space here,
452 // before and after the aligned area
453 // It is not a huge problem because we never commit
454 // that memory
455 start = MBLOCK_ROUND_UP(heap_base);
456
457 return start;
458 }
459
460 void osCommitMemory (void *at, W_ size)
461 {
462 void *temp;
463 temp = VirtualAlloc(at, size, MEM_COMMIT, PAGE_READWRITE);
464 if (temp == NULL) {
465 sysErrorBelch("osCommitMemory: VirtualAlloc MEM_COMMIT failed");
466 stg_exit(EXIT_FAILURE);
467 }
468 }
469
470 void osDecommitMemory (void *at, W_ size)
471 {
472 if (!VirtualFree(at, size, MEM_DECOMMIT)) {
473 sysErrorBelch("osDecommitMemory: VirtualFree MEM_DECOMMIT failed");
474 stg_exit(EXIT_FAILURE);
475 }
476 }
477
478 void osReleaseHeapMemory (void)
479 {
480 VirtualFree(heap_base, 0, MEM_RELEASE);
481 }
482
483 #endif