1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team 1998-2005
5 * The block allocator and free list manager.
7 * This is the architecture independent part of the block allocator.
8 * It requires only the following support from the operating system:
12 * returns the address of an MBLOCK_SIZE region of memory, aligned on
13 * an MBLOCK_SIZE boundary. There is no requirement for successive
14 * calls to getMBlock to return strictly increasing addresses.
16 * ---------------------------------------------------------------------------*/
18 #include "PosixSource.h"
22 #include "BlockAlloc.h"
27 static void initMBlock(void *mblock);
28 static bdescr *allocMegaGroup(nat mblocks);
29 static void freeMegaGroup(bdescr *bd);
31 static bdescr *free_list = NULL;
33 /* -----------------------------------------------------------------------------
35 -------------------------------------------------------------------------- */
37 void initBlockAllocator(void)
39 // The free list starts off NULL
42 /* -----------------------------------------------------------------------------
44 -------------------------------------------------------------------------- */
47 initGroupTail(nat n, bdescr *head, bdescr *tail)
52 for (i=0, bd = tail; i < n; i++, bd++) {
61 initGroup(nat n, bdescr *head)
65 head->free = head->start;
68 initGroupTail( n-1, head, head+1 );
80 if (n > BLOCKS_PER_MBLOCK) {
81 return allocMegaGroup(BLOCKS_TO_MBLOCKS(n));
85 for (bd = free_list; bd != NULL; bd = bd->link) {
86 if (bd->blocks == n) { /* exactly the right size! */
88 bd->link->u.back = bd->u.back;
91 /* no initialisation necessary - this is already a
92 * self-contained block group. */
98 if (bd->blocks > n) { /* block too big... */
99 bd->blocks -= n; /* take a chunk off the *end* */
101 initGroup(n, bd); /* initialise it */
107 mblock = getMBlock(); /* get a new megablock */
108 initMBlock(mblock); /* initialise the start fields */
109 bd = FIRST_BDESCR(mblock);
110 initGroup(n,bd); /* we know the group will fit */
111 if (n < BLOCKS_PER_MBLOCK) {
112 initGroup(BLOCKS_PER_MBLOCK-n, bd+n);
113 freeGroup(bd+n); /* add the rest on to the free list */
121 return allocGroup(1);
124 /* -----------------------------------------------------------------------------
125 Any request larger than BLOCKS_PER_MBLOCK needs a megablock group.
126 First, search the free list for enough contiguous megablocks to
127 fulfill the request - if we don't have enough, we need to
128 allocate some new ones.
130 A megablock group looks just like a normal block group, except that
131 the blocks field in the head will be larger than BLOCKS_PER_MBLOCK.
133 Note that any objects placed in this group must start in the first
134 megablock, since the other blocks don't have block descriptors.
135 -------------------------------------------------------------------------- */
138 allocMegaGroup(nat n)
141 bdescr *bd, *last, *grp_start, *grp_prev;
147 for (bd = free_list; bd != NULL; bd = bd->link) {
149 if (bd->blocks == BLOCKS_PER_MBLOCK) { /* whole megablock found */
151 /* is it the first one we've found or a non-contiguous megablock? */
152 if (grp_start == NULL ||
153 bd->start != last->start + MBLOCK_SIZE/sizeof(W_)) {
161 if (mbs_found == n) { /* found enough contig megablocks? */
166 else { /* only a partial megablock, start again */
173 /* found all the megablocks we need on the free list */
174 if (mbs_found == n) {
175 /* remove the megablocks from the free list */
176 if (grp_prev == NULL) { /* bd now points to the last mblock */
177 free_list = bd->link;
179 free_list->u.back = NULL;
182 grp_prev->link = bd->link;
184 bd->link->u.back = grp_prev;
189 /* the free list wasn't sufficient, allocate all new mblocks. */
191 void *mblock = getMBlocks(n);
192 initMBlock(mblock); /* only need to init the 1st one */
193 grp_start = FIRST_BDESCR(mblock);
196 /* set up the megablock group */
197 initGroup(BLOCKS_PER_MBLOCK, grp_start);
198 grp_start->blocks = MBLOCK_GROUP_BLOCKS(n);
202 /* -----------------------------------------------------------------------------
204 -------------------------------------------------------------------------- */
206 /* coalesce the group p with its predecessor and successor groups, if possible
208 * Returns NULL if no coalescing was done, otherwise returns a
209 * pointer to the newly enlarged group p.
212 STATIC_INLINE bdescr *
215 bdescr *first, *q, *result = NULL;
217 /* Get first megablock descriptor */
218 first = FIRST_BDESCR(MBLOCK_ROUND_DOWN(p->start));
220 /* Attempt to coalesce with predecessor if not the first block */
223 if (!q->blocks) { // not a block head?
224 q = q->link; // find the head.
226 /* Predecessor is free? */
227 if (q->flags & BF_FREE) {
228 q->blocks += p->blocks;
229 initGroupTail( p->blocks, q, p );
234 /* Attempt to coalesce with successor if not the last block */
236 if (q != first + BLOCKS_PER_MBLOCK) {
237 /* Successor is free */
238 if (q->flags & BF_FREE) {
240 /* p is on free_list, q is on free_list, unlink
241 * q completely and patch up list
244 q->u.back->link = q->link;
247 q->link->u.back = q->u.back;
249 if (free_list == q) {
253 /* p is not on free_list just assume q's links */
254 p->u.back = q->u.back;
262 if (q == free_list) {
264 free_list->u.back = NULL;
268 p->blocks += q->blocks;
269 initGroupTail( q->blocks, p, q );
280 /* are we dealing with a megablock group? */
281 if (p->blocks > BLOCKS_PER_MBLOCK) {
291 /* fill the block group with garbage if sanity checking is on */
292 IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE));
295 dbl_link_onto(p, &free_list);
298 IF_DEBUG(sanity, checkFreeListSanity());
302 freeMegaGroup(bdescr *p)
307 n = ((bdescr *)q)->blocks * BLOCK_SIZE / MBLOCK_SIZE + 1;
308 for (; n > 0; q += MBLOCK_SIZE, n--) {
309 initMBlock(MBLOCK_ROUND_DOWN(q));
310 initGroup(BLOCKS_PER_MBLOCK, (bdescr *)q);
311 freeGroup((bdescr *)q);
316 freeChain(bdescr *bd)
327 initMBlock(void *mblock)
332 /* the first few Bdescr's in a block are unused, so we don't want to
333 * put them all on the free list.
335 block = FIRST_BLOCK(mblock);
336 bd = FIRST_BDESCR(mblock);
338 /* Initialise the start field of each block descriptor
340 for (; block <= LAST_BLOCK(mblock); bd += 1, block += BLOCK_SIZE) {
345 /* -----------------------------------------------------------------------------
347 -------------------------------------------------------------------------- */
351 checkWellFormedGroup(bdescr *bd)
355 for (i = 1; i < bd->blocks; i++) {
356 ASSERT(bd[i].blocks == 0);
357 ASSERT(bd[i].free == 0);
358 ASSERT(bd[i].link == bd);
363 checkFreeListSanity(void)
367 for (bd = free_list; bd != NULL; bd = bd->link) {
368 IF_DEBUG(block_alloc,
369 debugBelch("group at 0x%x, length %d blocks\n",
370 (nat)bd->start, bd->blocks));
371 ASSERT(bd->blocks > 0);
372 ASSERT(bd->link ? bd->link->u.back == bd : 1);
373 ASSERT(bd->u.back ? bd->u.back->link == bd : 1);
374 checkWellFormedGroup(bd);
375 if (bd->link != NULL) {
376 /* make sure we're fully coalesced */
377 ASSERT(bd->start + bd->blocks * BLOCK_SIZE_W != bd->link->start);
386 lnat total_blocks = 0;
388 for (bd = free_list; bd != NULL; bd = bd->link) {
389 total_blocks += bd->blocks;