ff1a6460a4673bfb9ef063dbdddbb19a136f513b
[ghc.git] / rts / sm / BlockAlloc.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team 1998-2008
4 *
5 * The block allocator and free list manager.
6 *
7 * This is the architecture independent part of the block allocator.
8 * It requires only the following support from the operating system:
9 *
10 * void *getMBlock(uint32_t n);
11 *
12 * returns the address of an n*MBLOCK_SIZE region of memory, aligned on
13 * an MBLOCK_SIZE boundary. There are no other restrictions on the
14 * addresses of memory returned by getMBlock().
15 *
16 * ---------------------------------------------------------------------------*/
17
18 #include "PosixSource.h"
19 #include "Rts.h"
20
21 #include "Storage.h"
22 #include "RtsUtils.h"
23 #include "BlockAlloc.h"
24 #include "OSMem.h"
25
26 #include <string.h>
27
28 static void initMBlock(void *mblock);
29
30 /* -----------------------------------------------------------------------------
31
32 Implementation notes
33 ~~~~~~~~~~~~~~~~~~~~
34
35 Terminology:
36 - bdescr = block descriptor
37 - bgroup = block group (1 or more adjacent blocks)
38 - mblock = mega block
39 - mgroup = mega group (1 or more adjacent mblocks)
40
41 Invariants on block descriptors
42 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
43 bd->start always points to the start of the block.
44
45 bd->free is either:
46 - zero for a non-group-head; bd->link points to the head
47 - (-1) for the head of a free block group
48 - or it points within the block (group)
49
50 bd->blocks is either:
51 - zero for a non-group-head; bd->link points to the head
52 - number of blocks in this group otherwise
53
54 bd->link either points to a block descriptor or is NULL
55
56 The following fields are not used by the allocator:
57 bd->flags
58 bd->gen_no
59 bd->gen
60 bd->dest
61
62 Exceptions: we don't maintain invariants for all the blocks within a
63 group on the free list, because it is expensive to modify every
64 bdescr in a group when coalescing. Just the head and last bdescrs
65 will be correct for a group on the free list.
66
67
68 Free lists
69 ~~~~~~~~~~
70
71 Preliminaries:
72 - most allocations are for a small number of blocks
73 - sometimes the OS gives us new memory backwards in the address
74 space, sometimes forwards, so we should not be biased towards
75 any particular layout in the address space
76 - We want to avoid fragmentation
77 - We want allocation and freeing to be O(1) or close.
78
79 Coalescing trick: when a bgroup is freed (freeGroup()), we can check
80 whether it can be coalesced with other free bgroups by checking the
81 bdescrs for the blocks on either side of it. This means that we can
82 coalesce in O(1) time. Every free bgroup must have its head and tail
83 bdescrs initialised, the rest don't matter.
84
85 We keep the free list in buckets, using a heap-sort strategy.
86 Bucket N contains blocks with sizes 2^N - 2^(N+1)-1. The list of
87 blocks in each bucket is doubly-linked, so that if a block is
88 coalesced we can easily remove it from its current free list.
89
90 To allocate a new block of size S, grab a block from bucket
91 log2ceiling(S) (i.e. log2() rounded up), in which all blocks are at
92 least as big as S, and split it if necessary. If there are no
93 blocks in that bucket, look at bigger buckets until a block is found
94 Allocation is therefore O(logN) time.
95
96 To free a block:
97 - coalesce it with neighbours.
98 - remove coalesced neighbour(s) from free list(s)
99 - add the new (coalesced) block to the front of the appropriate
100 bucket, given by log2(S) where S is the size of the block.
101
102 Free is O(1).
103
104 Megablocks
105 ~~~~~~~~~~
106
107 Separately from the free list of block groups, which are smaller than
108 an mblock, we maintain a free list of mblock groups. This is the unit
109 of memory the operating system gives us, and we may either split mblocks
110 into blocks or allocate them directly (when very large contiguous regions
111 of memory). mblocks have a different set of invariants than blocks:
112
113 bd->start points to the start of the block IF the block is in the first mblock
114 bd->blocks and bd->link are only valid IF this block is the first block
115 of the first mblock
116 No other fields are used (in particular, free is not used, meaning that
117 space that is not used by the (single) object is wasted.
118
119 This has implications for the free list as well:
120 We cannot play the coalescing trick with mblocks, because there is
121 no requirement that the bdescrs in the second and subsequent mblock
122 of an mgroup are initialised (the mgroup might be filled with a
123 large array, overwriting the bdescrs for example).
124
125 The separate free list for megablocks is thus sorted in *address*
126 order, so that we can coalesce. Allocation in this list is best-fit
127 by traversing the whole list: we don't expect this list to be long,
128 and allocation/freeing of large blocks is rare; avoiding
129 fragmentation is more important than performance here.
130
131 freeGroup() might end up moving a block from free_list to
132 free_mblock_list, if after coalescing we end up with a full mblock.
133
134 checkFreeListSanity() checks all the invariants on the free lists.
135
136 --------------------------------------------------------------------------- */
137
138 /* ---------------------------------------------------------------------------
139 WATCH OUT FOR OVERFLOW
140
141 Be very careful with integer overflow here. If you have an
142 expression like (n_blocks * BLOCK_SIZE), and n_blocks is an int or
143 a uint32_t, then it will very likely overflow on a 64-bit platform.
144 Always cast to StgWord (or W_ for short) first: ((W_)n_blocks * BLOCK_SIZE).
145
146 --------------------------------------------------------------------------- */
147
148 // free_list[i] contains blocks that are at least size 2^i, and at
149 // most size 2^(i+1) - 1.
150 //
151 // To find the free list in which to place a block, use log_2(size).
152 // To find a free block of the right size, use log_2_ceil(size).
153 //
154 // The largest free list (free_list[NUM_FREE_LISTS-1]) needs to contain sizes
155 // from half a megablock up to (but not including) a full megablock.
156
157 #define NUM_FREE_LISTS (MBLOCK_SHIFT-BLOCK_SHIFT)
158
159 // In THREADED_RTS mode, the free list is protected by sm_mutex.
160
161 static bdescr *free_list[NUM_FREE_LISTS];
162 static bdescr *free_mblock_list;
163
164 W_ n_alloc_blocks; // currently allocated blocks
165 W_ hw_alloc_blocks; // high-water allocated blocks
166
167 /* -----------------------------------------------------------------------------
168 Initialisation
169 -------------------------------------------------------------------------- */
170
171 void initBlockAllocator(void)
172 {
173 uint32_t i;
174 for (i=0; i < NUM_FREE_LISTS; i++) {
175 free_list[i] = NULL;
176 }
177 free_mblock_list = NULL;
178 n_alloc_blocks = 0;
179 hw_alloc_blocks = 0;
180 }
181
182 /* -----------------------------------------------------------------------------
183 Allocation
184 -------------------------------------------------------------------------- */
185
186 STATIC_INLINE void
187 initGroup(bdescr *head)
188 {
189 head->free = head->start;
190 head->link = NULL;
191
192 // If this is a block group (but not a megablock group), we
193 // make the last block of the group point to the head. This is used
194 // when coalescing blocks in freeGroup(). We don't do this for
195 // megablock groups because blocks in the second and subsequent
196 // mblocks don't have bdescrs; freeing these is handled in a
197 // different way by free_mblock_group().
198 if (head->blocks > 1 && head->blocks <= BLOCKS_PER_MBLOCK) {
199 bdescr *last = head + head->blocks-1;
200 last->blocks = 0;
201 last->link = head;
202 }
203 }
204
205 #if SIZEOF_VOID_P == SIZEOF_LONG
206 #define CLZW(n) (__builtin_clzl(n))
207 #else
208 #define CLZW(n) (__builtin_clzll(n))
209 #endif
210
211 // log base 2 (floor), needs to support up to (2^NUM_FREE_LISTS)-1
212 STATIC_INLINE uint32_t
213 log_2(W_ n)
214 {
215 ASSERT(n > 0 && n < (1<<NUM_FREE_LISTS));
216 #if defined(__GNUC__)
217 return CLZW(n) ^ (sizeof(StgWord)*8 - 1);
218 // generates good code on x86. __builtin_clz() compiles to bsr+xor, but
219 // we want just bsr, so the xor here cancels out gcc's xor.
220 #else
221 W_ i, x;
222 x = n;
223 for (i=0; i < NUM_FREE_LISTS; i++) {
224 x = x >> 1;
225 if (x == 0) return i;
226 }
227 return NUM_FREE_LISTS;
228 #endif
229 }
230
231 // log base 2 (ceiling), needs to support up to (2^NUM_FREE_LISTS)-1
232 STATIC_INLINE uint32_t
233 log_2_ceil(W_ n)
234 {
235 ASSERT(n > 0 && n < (1<<NUM_FREE_LISTS));
236 #if defined(__GNUC__)
237 uint32_t r = log_2(n);
238 return (n & (n-1)) ? r+1 : r;
239 #else
240 W_ i, x;
241 x = 1;
242 for (i=0; i < MAX_FREE_LIST; i++) {
243 if (x >= n) return i;
244 x = x << 1;
245 }
246 return MAX_FREE_LIST;
247 #endif
248 }
249
250 STATIC_INLINE void
251 free_list_insert (bdescr *bd)
252 {
253 uint32_t ln;
254
255 ASSERT(bd->blocks < BLOCKS_PER_MBLOCK);
256 ln = log_2(bd->blocks);
257
258 dbl_link_onto(bd, &free_list[ln]);
259 }
260
261
262 STATIC_INLINE bdescr *
263 tail_of (bdescr *bd)
264 {
265 return bd + bd->blocks - 1;
266 }
267
268 // After splitting a group, the last block of each group must have a
269 // tail that points to the head block, to keep our invariants for
270 // coalescing.
271 STATIC_INLINE void
272 setup_tail (bdescr *bd)
273 {
274 bdescr *tail;
275 tail = tail_of(bd);
276 if (tail != bd) {
277 tail->blocks = 0;
278 tail->free = 0;
279 tail->link = bd;
280 }
281 }
282
283
284 // Take a free block group bd, and split off a group of size n from
285 // it. Adjust the free list as necessary, and return the new group.
286 static bdescr *
287 split_free_block (bdescr *bd, W_ n, uint32_t ln)
288 {
289 bdescr *fg; // free group
290
291 ASSERT(bd->blocks > n);
292 dbl_link_remove(bd, &free_list[ln]);
293 fg = bd + bd->blocks - n; // take n blocks off the end
294 fg->blocks = n;
295 bd->blocks -= n;
296 setup_tail(bd);
297 ln = log_2(bd->blocks);
298 dbl_link_onto(bd, &free_list[ln]);
299 return fg;
300 }
301
302 /* Only initializes the start pointers on the first megablock and the
303 * blocks field of the first bdescr; callers are responsible for calling
304 * initGroup afterwards.
305 */
306 static bdescr *
307 alloc_mega_group (StgWord mblocks)
308 {
309 bdescr *best, *bd, *prev;
310 StgWord n;
311
312 n = MBLOCK_GROUP_BLOCKS(mblocks);
313
314 best = NULL;
315 prev = NULL;
316 for (bd = free_mblock_list; bd != NULL; prev = bd, bd = bd->link)
317 {
318 if (bd->blocks == n)
319 {
320 if (prev) {
321 prev->link = bd->link;
322 } else {
323 free_mblock_list = bd->link;
324 }
325 return bd;
326 }
327 else if (bd->blocks > n)
328 {
329 if (!best || bd->blocks < best->blocks)
330 {
331 best = bd;
332 }
333 }
334 }
335
336 if (best)
337 {
338 // we take our chunk off the end here.
339 StgWord best_mblocks = BLOCKS_TO_MBLOCKS(best->blocks);
340 bd = FIRST_BDESCR((StgWord8*)MBLOCK_ROUND_DOWN(best) +
341 (best_mblocks-mblocks)*MBLOCK_SIZE);
342
343 best->blocks = MBLOCK_GROUP_BLOCKS(best_mblocks - mblocks);
344 initMBlock(MBLOCK_ROUND_DOWN(bd));
345 }
346 else
347 {
348 void *mblock = getMBlocks(mblocks);
349 initMBlock(mblock); // only need to init the 1st one
350 bd = FIRST_BDESCR(mblock);
351 }
352 bd->blocks = MBLOCK_GROUP_BLOCKS(mblocks);
353 return bd;
354 }
355
356 bdescr *
357 allocGroup (W_ n)
358 {
359 bdescr *bd, *rem;
360 StgWord ln;
361
362 if (n == 0) barf("allocGroup: requested zero blocks");
363
364 if (n >= BLOCKS_PER_MBLOCK)
365 {
366 StgWord mblocks;
367
368 mblocks = BLOCKS_TO_MBLOCKS(n);
369
370 // n_alloc_blocks doesn't count the extra blocks we get in a
371 // megablock group.
372 n_alloc_blocks += mblocks * BLOCKS_PER_MBLOCK;
373 if (n_alloc_blocks > hw_alloc_blocks) hw_alloc_blocks = n_alloc_blocks;
374
375 bd = alloc_mega_group(mblocks);
376 // only the bdescrs of the first MB are required to be initialised
377 initGroup(bd);
378 goto finish;
379 }
380
381 n_alloc_blocks += n;
382 if (n_alloc_blocks > hw_alloc_blocks) hw_alloc_blocks = n_alloc_blocks;
383
384 ln = log_2_ceil(n);
385
386 while (ln < NUM_FREE_LISTS && free_list[ln] == NULL) {
387 ln++;
388 }
389
390 if (ln == NUM_FREE_LISTS) {
391 #if 0 /* useful for debugging fragmentation */
392 if ((W_)mblocks_allocated * BLOCKS_PER_MBLOCK * BLOCK_SIZE_W
393 - (W_)((n_alloc_blocks - n) * BLOCK_SIZE_W) > (2*1024*1024)/sizeof(W_)) {
394 debugBelch("Fragmentation, wanted %d blocks, %ld MB free\n", n, ((mblocks_allocated * BLOCKS_PER_MBLOCK) - n_alloc_blocks) / BLOCKS_PER_MBLOCK);
395 RtsFlags.DebugFlags.block_alloc = 1;
396 checkFreeListSanity();
397 }
398 #endif
399
400 bd = alloc_mega_group(1);
401 bd->blocks = n;
402 initGroup(bd); // we know the group will fit
403 rem = bd + n;
404 rem->blocks = BLOCKS_PER_MBLOCK-n;
405 initGroup(rem); // init the slop
406 n_alloc_blocks += rem->blocks;
407 freeGroup(rem); // add the slop on to the free list
408 goto finish;
409 }
410
411 bd = free_list[ln];
412
413 if (bd->blocks == n) // exactly the right size!
414 {
415 dbl_link_remove(bd, &free_list[ln]);
416 initGroup(bd);
417 }
418 else if (bd->blocks > n) // block too big...
419 {
420 bd = split_free_block(bd, n, ln);
421 ASSERT(bd->blocks == n);
422 initGroup(bd);
423 }
424 else
425 {
426 barf("allocGroup: free list corrupted");
427 }
428
429 finish:
430 IF_DEBUG(sanity, memset(bd->start, 0xaa, bd->blocks * BLOCK_SIZE));
431 IF_DEBUG(sanity, checkFreeListSanity());
432 return bd;
433 }
434
435 //
436 // Allocate a chunk of blocks that is at least min and at most max
437 // blocks in size. This API is used by the nursery allocator that
438 // wants contiguous memory preferably, but doesn't require it. When
439 // memory is fragmented we might have lots of chunks that are
440 // less than a full megablock, so allowing the nursery allocator to
441 // use these reduces fragmentation considerably. e.g. on a GHC build
442 // with +RTS -H, I saw fragmentation go from 17MB down to 3MB on a
443 // single compile.
444 //
445 // Further to this: in #7257 there is a program that creates serious
446 // fragmentation such that the heap is full of tiny <4 block chains.
447 // The nursery allocator therefore has to use single blocks to avoid
448 // fragmentation, but we make sure that we allocate large blocks
449 // preferably if there are any.
450 //
451 bdescr *
452 allocLargeChunk (W_ min, W_ max)
453 {
454 bdescr *bd;
455 StgWord ln, lnmax;
456
457 if (min >= BLOCKS_PER_MBLOCK) {
458 return allocGroup(max);
459 }
460
461 ln = log_2_ceil(min);
462 lnmax = log_2_ceil(max);
463
464 while (ln < NUM_FREE_LISTS && ln < lnmax && free_list[ln] == NULL) {
465 ln++;
466 }
467 if (ln == NUM_FREE_LISTS || ln == lnmax) {
468 return allocGroup(max);
469 }
470 bd = free_list[ln];
471
472 if (bd->blocks <= max) // exactly the right size!
473 {
474 dbl_link_remove(bd, &free_list[ln]);
475 initGroup(bd);
476 }
477 else // block too big...
478 {
479 bd = split_free_block(bd, max, ln);
480 ASSERT(bd->blocks == max);
481 initGroup(bd);
482 }
483
484 n_alloc_blocks += bd->blocks;
485 if (n_alloc_blocks > hw_alloc_blocks) hw_alloc_blocks = n_alloc_blocks;
486
487 IF_DEBUG(sanity, memset(bd->start, 0xaa, bd->blocks * BLOCK_SIZE));
488 IF_DEBUG(sanity, checkFreeListSanity());
489 return bd;
490 }
491
492 bdescr *
493 allocGroup_lock(W_ n)
494 {
495 bdescr *bd;
496 ACQUIRE_SM_LOCK;
497 bd = allocGroup(n);
498 RELEASE_SM_LOCK;
499 return bd;
500 }
501
502 bdescr *
503 allocBlock(void)
504 {
505 return allocGroup(1);
506 }
507
508 bdescr *
509 allocBlock_lock(void)
510 {
511 bdescr *bd;
512 ACQUIRE_SM_LOCK;
513 bd = allocBlock();
514 RELEASE_SM_LOCK;
515 return bd;
516 }
517
518 /* -----------------------------------------------------------------------------
519 De-Allocation
520 -------------------------------------------------------------------------- */
521
522 STATIC_INLINE bdescr *
523 coalesce_mblocks (bdescr *p)
524 {
525 bdescr *q;
526
527 q = p->link;
528 if (q != NULL &&
529 MBLOCK_ROUND_DOWN(q) ==
530 (StgWord8*)MBLOCK_ROUND_DOWN(p) +
531 BLOCKS_TO_MBLOCKS(p->blocks) * MBLOCK_SIZE) {
532 // can coalesce
533 p->blocks = MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(p->blocks) +
534 BLOCKS_TO_MBLOCKS(q->blocks));
535 p->link = q->link;
536 return p;
537 }
538 return q;
539 }
540
541 static void
542 free_mega_group (bdescr *mg)
543 {
544 bdescr *bd, *prev;
545
546 // Find the right place in the free list. free_mblock_list is
547 // sorted by *address*, not by size as the free_list is.
548 prev = NULL;
549 bd = free_mblock_list;
550 while (bd && bd->start < mg->start) {
551 prev = bd;
552 bd = bd->link;
553 }
554
555 // coalesce backwards
556 if (prev)
557 {
558 mg->link = prev->link;
559 prev->link = mg;
560 mg = coalesce_mblocks(prev);
561 }
562 else
563 {
564 mg->link = free_mblock_list;
565 free_mblock_list = mg;
566 }
567 // coalesce forwards
568 coalesce_mblocks(mg);
569
570 IF_DEBUG(sanity, checkFreeListSanity());
571 }
572
573
574 void
575 freeGroup(bdescr *p)
576 {
577 StgWord ln;
578
579 // Todo: not true in multithreaded GC
580 // ASSERT_SM_LOCK();
581
582 ASSERT(p->free != (P_)-1);
583
584 p->free = (void *)-1; /* indicates that this block is free */
585 p->gen = NULL;
586 p->gen_no = 0;
587 /* fill the block group with garbage if sanity checking is on */
588 IF_DEBUG(sanity,memset(p->start, 0xaa, (W_)p->blocks * BLOCK_SIZE));
589
590 if (p->blocks == 0) barf("freeGroup: block size is zero");
591
592 if (p->blocks >= BLOCKS_PER_MBLOCK)
593 {
594 StgWord mblocks;
595
596 mblocks = BLOCKS_TO_MBLOCKS(p->blocks);
597 // If this is an mgroup, make sure it has the right number of blocks
598 ASSERT(p->blocks == MBLOCK_GROUP_BLOCKS(mblocks));
599
600 n_alloc_blocks -= mblocks * BLOCKS_PER_MBLOCK;
601
602 free_mega_group(p);
603 return;
604 }
605
606 ASSERT(n_alloc_blocks >= p->blocks);
607 n_alloc_blocks -= p->blocks;
608
609 // coalesce forwards
610 {
611 bdescr *next;
612 next = p + p->blocks;
613 if (next <= LAST_BDESCR(MBLOCK_ROUND_DOWN(p)) && next->free == (P_)-1)
614 {
615 p->blocks += next->blocks;
616 ln = log_2(next->blocks);
617 dbl_link_remove(next, &free_list[ln]);
618 if (p->blocks == BLOCKS_PER_MBLOCK)
619 {
620 free_mega_group(p);
621 return;
622 }
623 setup_tail(p);
624 }
625 }
626
627 // coalesce backwards
628 if (p != FIRST_BDESCR(MBLOCK_ROUND_DOWN(p)))
629 {
630 bdescr *prev;
631 prev = p - 1;
632 if (prev->blocks == 0) prev = prev->link; // find the head
633
634 if (prev->free == (P_)-1)
635 {
636 ln = log_2(prev->blocks);
637 dbl_link_remove(prev, &free_list[ln]);
638 prev->blocks += p->blocks;
639 if (prev->blocks >= BLOCKS_PER_MBLOCK)
640 {
641 free_mega_group(prev);
642 return;
643 }
644 p = prev;
645 }
646 }
647
648 setup_tail(p);
649 free_list_insert(p);
650
651 IF_DEBUG(sanity, checkFreeListSanity());
652 }
653
654 void
655 freeGroup_lock(bdescr *p)
656 {
657 ACQUIRE_SM_LOCK;
658 freeGroup(p);
659 RELEASE_SM_LOCK;
660 }
661
662 void
663 freeChain(bdescr *bd)
664 {
665 bdescr *next_bd;
666 while (bd != NULL) {
667 next_bd = bd->link;
668 freeGroup(bd);
669 bd = next_bd;
670 }
671 }
672
673 void
674 freeChain_lock(bdescr *bd)
675 {
676 ACQUIRE_SM_LOCK;
677 freeChain(bd);
678 RELEASE_SM_LOCK;
679 }
680
681 static void
682 initMBlock(void *mblock)
683 {
684 bdescr *bd;
685 StgWord8 *block;
686
687 /* the first few Bdescr's in a block are unused, so we don't want to
688 * put them all on the free list.
689 */
690 block = FIRST_BLOCK(mblock);
691 bd = FIRST_BDESCR(mblock);
692
693 /* Initialise the start field of each block descriptor
694 */
695 for (; block <= (StgWord8*)LAST_BLOCK(mblock); bd += 1,
696 block += BLOCK_SIZE) {
697 bd->start = (void*)block;
698 }
699 }
700
701 /* -----------------------------------------------------------------------------
702 Stats / metrics
703 -------------------------------------------------------------------------- */
704
705 W_
706 countBlocks(bdescr *bd)
707 {
708 W_ n;
709 for (n=0; bd != NULL; bd=bd->link) {
710 n += bd->blocks;
711 }
712 return n;
713 }
714
715 // (*1) Just like countBlocks, except that we adjust the count for a
716 // megablock group so that it doesn't include the extra few blocks
717 // that would be taken up by block descriptors in the second and
718 // subsequent megablock. This is so we can tally the count with the
719 // number of blocks allocated in the system, for memInventory().
720 W_
721 countAllocdBlocks(bdescr *bd)
722 {
723 W_ n;
724 for (n=0; bd != NULL; bd=bd->link) {
725 n += bd->blocks;
726 // hack for megablock groups: see (*1) above
727 if (bd->blocks > BLOCKS_PER_MBLOCK) {
728 n -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK)
729 * (bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE));
730 }
731 }
732 return n;
733 }
734
735 void returnMemoryToOS(uint32_t n /* megablocks */)
736 {
737 static bdescr *bd;
738 StgWord size;
739
740 bd = free_mblock_list;
741 while ((n > 0) && (bd != NULL)) {
742 size = BLOCKS_TO_MBLOCKS(bd->blocks);
743 if (size > n) {
744 StgWord newSize = size - n;
745 char *freeAddr = MBLOCK_ROUND_DOWN(bd->start);
746 freeAddr += newSize * MBLOCK_SIZE;
747 bd->blocks = MBLOCK_GROUP_BLOCKS(newSize);
748 freeMBlocks(freeAddr, n);
749 n = 0;
750 }
751 else {
752 char *freeAddr = MBLOCK_ROUND_DOWN(bd->start);
753 n -= size;
754 bd = bd->link;
755 freeMBlocks(freeAddr, size);
756 }
757 }
758 free_mblock_list = bd;
759
760 // Ask the OS to release any address space portion
761 // that was associated with the just released MBlocks
762 //
763 // Historically, we used to ask the OS directly (via
764 // osReleaseFreeMemory()) - now the MBlock layer might
765 // have a reason to preserve the address space range,
766 // so we keep it
767 releaseFreeMemory();
768
769 IF_DEBUG(gc,
770 if (n != 0) {
771 debugBelch("Wanted to free %d more MBlocks than are freeable\n",
772 n);
773 }
774 );
775 }
776
777 /* -----------------------------------------------------------------------------
778 Debugging
779 -------------------------------------------------------------------------- */
780
781 #ifdef DEBUG
782 static void
783 check_tail (bdescr *bd)
784 {
785 bdescr *tail = tail_of(bd);
786
787 if (tail != bd)
788 {
789 ASSERT(tail->blocks == 0);
790 ASSERT(tail->free == 0);
791 ASSERT(tail->link == bd);
792 }
793 }
794
795 void
796 checkFreeListSanity(void)
797 {
798 bdescr *bd, *prev;
799 StgWord ln, min;
800
801
802 min = 1;
803 for (ln = 0; ln < NUM_FREE_LISTS; ln++) {
804 IF_DEBUG(block_alloc,
805 debugBelch("free block list [%" FMT_Word "]:\n", ln));
806
807 prev = NULL;
808 for (bd = free_list[ln]; bd != NULL; prev = bd, bd = bd->link)
809 {
810 IF_DEBUG(block_alloc,
811 debugBelch("group at %p, length %ld blocks\n",
812 bd->start, (long)bd->blocks));
813 ASSERT(bd->free == (P_)-1);
814 ASSERT(bd->blocks > 0 && bd->blocks < BLOCKS_PER_MBLOCK);
815 ASSERT(bd->blocks >= min && bd->blocks <= (min*2 - 1));
816 ASSERT(bd->link != bd); // catch easy loops
817
818 check_tail(bd);
819
820 if (prev)
821 ASSERT(bd->u.back == prev);
822 else
823 ASSERT(bd->u.back == NULL);
824
825 {
826 bdescr *next;
827 next = bd + bd->blocks;
828 if (next <= LAST_BDESCR(MBLOCK_ROUND_DOWN(bd)))
829 {
830 ASSERT(next->free != (P_)-1);
831 }
832 }
833 }
834 min = min << 1;
835 }
836
837 prev = NULL;
838 for (bd = free_mblock_list; bd != NULL; prev = bd, bd = bd->link)
839 {
840 IF_DEBUG(block_alloc,
841 debugBelch("mega group at %p, length %ld blocks\n",
842 bd->start, (long)bd->blocks));
843
844 ASSERT(bd->link != bd); // catch easy loops
845
846 if (bd->link != NULL)
847 {
848 // make sure the list is sorted
849 ASSERT(bd->start < bd->link->start);
850 }
851
852 ASSERT(bd->blocks >= BLOCKS_PER_MBLOCK);
853 ASSERT(MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(bd->blocks))
854 == bd->blocks);
855
856 // make sure we're fully coalesced
857 if (bd->link != NULL)
858 {
859 ASSERT(MBLOCK_ROUND_DOWN(bd->link) !=
860 (StgWord8*)MBLOCK_ROUND_DOWN(bd) +
861 BLOCKS_TO_MBLOCKS(bd->blocks) * MBLOCK_SIZE);
862 }
863 }
864 }
865
866 W_ /* BLOCKS */
867 countFreeList(void)
868 {
869 bdescr *bd;
870 W_ total_blocks = 0;
871 StgWord ln;
872
873 for (ln=0; ln < NUM_FREE_LISTS; ln++) {
874 for (bd = free_list[ln]; bd != NULL; bd = bd->link) {
875 total_blocks += bd->blocks;
876 }
877 }
878 for (bd = free_mblock_list; bd != NULL; bd = bd->link) {
879 total_blocks += BLOCKS_PER_MBLOCK * BLOCKS_TO_MBLOCKS(bd->blocks);
880 // The caller of this function, memInventory(), expects to match
881 // the total number of blocks in the system against mblocks *
882 // BLOCKS_PER_MBLOCK, so we must subtract the space for the
883 // block descriptors from *every* mblock.
884 }
885 return total_blocks;
886 }
887
888 void
889 markBlocks (bdescr *bd)
890 {
891 for (; bd != NULL; bd = bd->link) {
892 bd->flags |= BF_KNOWN;
893 }
894 }
895
896 void
897 reportUnmarkedBlocks (void)
898 {
899 void *mblock;
900 void *state;
901 bdescr *bd;
902
903 debugBelch("Unreachable blocks:\n");
904 for (mblock = getFirstMBlock(&state); mblock != NULL;
905 mblock = getNextMBlock(&state, mblock)) {
906 for (bd = FIRST_BDESCR(mblock); bd <= LAST_BDESCR(mblock); ) {
907 if (!(bd->flags & BF_KNOWN) && bd->free != (P_)-1) {
908 debugBelch(" %p\n",bd);
909 }
910 if (bd->blocks >= BLOCKS_PER_MBLOCK) {
911 mblock = (StgWord8*)mblock +
912 (BLOCKS_TO_MBLOCKS(bd->blocks) - 1) * MBLOCK_SIZE;
913 break;
914 } else {
915 bd += bd->blocks;
916 }
917 }
918 }
919 }
920
921 #endif