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