1 /* -----------------------------------------------------------------------------
3 * (c) The University of Glasgow 2006-2007
5 * OS-specific memory management
7 * ---------------------------------------------------------------------------*/
17 /* alloc_rec keeps the info we need to have matching VirtualAlloc and
20 typedef struct alloc_rec_ {
21 char* base; /* non-aligned base address, directly from VirtualAlloc */
22 int size; /* Size in bytes */
23 struct alloc_rec_* next;
26 typedef struct block_rec_ {
27 char* base; /* base address, non-MBLOCK-aligned */
28 int size; /* size in bytes */
29 struct block_rec_* next;
32 static alloc_rec* allocs = NULL;
33 static block_rec* free_blocks = NULL;
46 rec = (alloc_rec*)stgMallocBytes(sizeof(alloc_rec),"getMBlocks: allocNew");
47 rec->size = (n+1)*MBLOCK_SIZE;
49 VirtualAlloc(NULL, rec->size, MEM_RESERVE, PAGE_READWRITE);
53 if (GetLastError() == ERROR_NOT_ENOUGH_MEMORY) {
55 errorBelch("out of memory");
58 "getMBlocks: VirtualAlloc MEM_RESERVE %d blocks failed", n);
62 temp.base=0; temp.size=0; temp.next=allocs;
66 for(; it->next!=0 && it->next->base<rec->base; it=it->next) ;
77 insertFree(char* alloc_base, int alloc_size) {
82 temp.base=0; temp.size=0; temp.next=free_blocks;
85 for( ; it!=0 && it->base<alloc_base; prev=it, it=it->next) {}
87 if(it!=0 && alloc_base+alloc_size == it->base) {
88 if(prev->base + prev->size == alloc_base) { /* Merge it, alloc, prev */
89 prev->size += alloc_size + it->size;
90 prev->next = it->next;
92 } else { /* Merge it, alloc */
93 it->base = alloc_base;
94 it->size += alloc_size;
96 } else if(prev->base + prev->size == alloc_base) { /* Merge alloc, prev */
97 prev->size += alloc_size;
98 } else { /* Merge none */
100 rec = (block_rec*)stgMallocBytes(sizeof(block_rec),"getMBlocks: insertFree");
101 rec->base=alloc_base;
102 rec->size=alloc_size;
106 free_blocks=temp.next;
111 findFreeBlocks(nat n) {
119 required_size = n*MBLOCK_SIZE;
120 temp.next=free_blocks; temp.base=0; temp.size=0;
122 /* TODO: Don't just take first block, find smallest sufficient block */
123 for( ; it!=0 && it->size<required_size; prev=it, it=it->next ) {}
125 if( (((unsigned long)it->base) & MBLOCK_MASK) == 0) { /* MBlock aligned */
126 ret = (void*)it->base;
127 if(it->size==required_size) {
131 it->base += required_size;
132 it->size -=required_size;
138 need_base = (char*)(((unsigned long)it->base) & ((unsigned long)~MBLOCK_MASK)) + MBLOCK_SIZE;
139 next = (block_rec*)stgMallocBytes(
141 , "getMBlocks: findFreeBlocks: splitting");
142 new_size = need_base - it->base;
143 next->base = need_base +required_size;
144 next->size = it->size - (new_size+required_size);
146 next->next = it->next;
148 ret=(void*)need_base;
151 free_blocks=temp.next;
155 /* VirtualAlloc MEM_COMMIT can't cross boundaries of VirtualAlloc MEM_RESERVE,
156 so we might need to do many VirtualAlloc MEM_COMMITs. We simply walk the
157 (ordered) allocated blocks. */
159 commitBlocks(char* base, int size) {
162 for( ; it!=0 && (it->base+it->size)<=base; it=it->next ) {}
163 for( ; it!=0 && size>0; it=it->next ) {
166 size_delta = it->size - (base-it->base);
167 if(size_delta>size) size_delta=size;
168 temp = VirtualAlloc(base, size_delta, MEM_COMMIT, PAGE_READWRITE);
170 sysErrorBelch("getMBlocks: VirtualAlloc MEM_COMMIT failed");
171 stg_exit(EXIT_FAILURE);
179 osGetMBlocks(nat n) {
181 ret = findFreeBlocks(n);
185 /* We already belch in allocNew if it fails */
187 stg_exit(EXIT_FAILURE);
189 insertFree(alloc->base, alloc->size);
190 ret = findFreeBlocks(n);
195 /* (In)sanity tests */
196 if (((W_)ret & MBLOCK_MASK) != 0) {
197 barf("getMBlocks: misaligned block returned");
200 commitBlocks(ret, MBLOCK_SIZE*n);
207 osFreeAllMBlocks(void)
226 if(!VirtualFree((void*)it->base, 0, MEM_RELEASE)) {
227 sysErrorBelch("freeAllMBlocks: VirtualFree MEM_RELEASE failed");
228 stg_exit(EXIT_FAILURE);
237 lnat getPageSize (void)
239 static lnat pagesize = 0;
243 SYSTEM_INFO sSysInfo;
244 GetSystemInfo(&sSysInfo);
245 pagesize = sSysInfo.dwPageSize;
250 void setExecutable (void *p, lnat len, rtsBool exec)
252 DWORD dwOldProtect = 0;
253 if (VirtualProtect (p, len,
254 exec ? PAGE_EXECUTE_READWRITE : PAGE_READWRITE,
257 sysErrorBelch("setExecutable: failed to protect 0x%p; old protection: %lu\n",
258 p, (unsigned long)dwOldProtect);
259 stg_exit(EXIT_FAILURE);