fix a tiny bug spotted by gcc 4.3
[ghc-hetmet.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(nat 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 #include "RtsFlags.h"
21 #include "RtsUtils.h"
22 #include "BlockAlloc.h"
23 #include "MBlock.h"
24 #include "Storage.h"
25
26 #include <string.h>
27
28 static void  initMBlock(void *mblock);
29
30 // The free_list is kept sorted by size, smallest first.
31 // In THREADED_RTS mode, the free list is protected by sm_mutex.
32
33 /* -----------------------------------------------------------------------------
34
35   Implementation notes
36   ~~~~~~~~~~~~~~~~~~~~
37
38   Terminology:
39     - bdescr = block descriptor
40     - bgroup = block group (1 or more adjacent blocks)
41     - mblock = mega block
42     - mgroup = mega group (1 or more adjacent mblocks)
43
44    Invariants on block descriptors
45    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
46    bd->start always points to the start of the block.
47
48    bd->free is either:
49       - zero for a non-group-head; bd->link points to the head
50       - (-1) for the head of a free block group
51       - or it points within the block
52
53    bd->blocks is either:
54       - zero for a non-group-head; bd->link points to the head
55       - number of blocks in this group otherwise
56
57    bd->link either points to a block descriptor or is NULL
58
59    The following fields are not used by the allocator:
60      bd->flags
61      bd->gen_no
62      bd->step
63
64   Exceptions: we don't maintain invariants for all the blocks within a
65   group on the free list, because it is expensive to modify every
66   bdescr in a group when coalescing.  Just the head and last bdescrs
67   will be correct for a group on the free list.
68
69
70   Free lists
71   ~~~~~~~~~~
72
73   Preliminaries:
74     - most allocations are for small blocks
75     - sometimes the OS gives us new memory backwards in the address
76       space, sometimes forwards, so we should not be biased towards
77       any particular layout in the address space
78     - We want to avoid fragmentation
79     - We want allocation and freeing to be O(1) or close.
80
81   Coalescing trick: when a bgroup is freed (freeGroup()), we can check
82   whether it can be coalesced with other free bgroups by checking the
83   bdescrs for the blocks on either side of it.  This means that we can
84   coalesce in O(1) time.  Every free bgroup must have its head and tail
85   bdescrs initialised, the rest don't matter.
86
87   We keep the free list in buckets, using a heap-sort strategy.
88   Bucket N contains blocks with sizes 2^N - 2^(N+1)-1.  The list of
89   blocks in each bucket is doubly-linked, so that if a block is
90   coalesced we can easily remove it from its current free list.
91
92   To allocate a new block of size S, grab a block from bucket
93   log2ceiling(S) (i.e. log2() rounded up), in which all blocks are at
94   least as big as S, and split it if necessary.  If there are no
95   blocks in that bucket, look at bigger buckets until a block is found
96   Allocation is therefore O(logN) time.
97
98   To free a block:
99     - coalesce it with neighbours.
100     - remove coalesced neighbour(s) from free list(s)
101     - add the new (coalesced) block to the front of the appropriate
102       bucket, given by log2(S) where S is the size of the block.
103
104   Free is O(1).
105
106   We cannot play this coalescing trick with mblocks, because there is
107   no requirement that the bdescrs in the second and subsequent mblock
108   of an mgroup are initialised (the mgroup might be filled with a
109   large array, overwriting the bdescrs for example).
110
111   So there is a separate free list for megablocks, sorted in *address*
112   order, so that we can coalesce.  Allocation in this list is best-fit
113   by traversing the whole list: we don't expect this list to be long,
114   and allocation/freeing of large blocks is rare; avoiding
115   fragmentation is more important than performance here.
116
117   freeGroup() might end up moving a block from free_list to
118   free_mblock_list, if after coalescing we end up with a full mblock.
119
120   checkFreeListSanity() checks all the invariants on the free lists.
121
122   --------------------------------------------------------------------------- */
123
124 #define MAX_FREE_LIST 9
125
126 static bdescr *free_list[MAX_FREE_LIST];
127 static bdescr *free_mblock_list;
128
129 // free_list[i] contains blocks that are at least size 2^i, and at
130 // most size 2^(i+1) - 1.  
131 // 
132 // To find the free list in which to place a block, use log_2(size).
133 // To find a free block of the right size, use log_2_ceil(size).
134
135 lnat n_alloc_blocks;   // currently allocated blocks
136 lnat hw_alloc_blocks;  // high-water allocated blocks
137
138 /* -----------------------------------------------------------------------------
139    Initialisation
140    -------------------------------------------------------------------------- */
141
142 void initBlockAllocator(void)
143 {
144     nat i;
145     for (i=0; i < MAX_FREE_LIST; i++) {
146         free_list[i] = NULL;
147     }
148     free_mblock_list = NULL;
149     n_alloc_blocks = 0;
150     hw_alloc_blocks = 0;
151 }
152
153 /* -----------------------------------------------------------------------------
154    Allocation
155    -------------------------------------------------------------------------- */
156
157 STATIC_INLINE void
158 initGroup(bdescr *head)
159 {
160   bdescr *bd;
161   nat i, n;
162
163   n = head->blocks;
164   head->free   = head->start;
165   head->link   = NULL;
166   for (i=1, bd = head+1; i < n; i++, bd++) {
167       bd->free = 0;
168       bd->blocks = 0;
169       bd->link = head;
170   }
171 }
172
173 // There are quicker non-loopy ways to do log_2, but we expect n to be
174 // usually small, and MAX_FREE_LIST is also small, so the loop version
175 // might well be the best choice here.
176 STATIC_INLINE nat
177 log_2_ceil(nat n)
178 {
179     nat i, x;
180     x = 1;
181     for (i=0; i < MAX_FREE_LIST; i++) {
182         if (x >= n) return i;
183         x = x << 1;
184     }
185     return MAX_FREE_LIST;
186 }
187
188 STATIC_INLINE nat
189 log_2(nat n)
190 {
191     nat i, x;
192     x = n;
193     for (i=0; i < MAX_FREE_LIST; i++) {
194         x = x >> 1;
195         if (x == 0) return i;
196     }
197     return MAX_FREE_LIST;
198 }
199
200 STATIC_INLINE void
201 free_list_insert (bdescr *bd)
202 {
203     nat ln;
204
205     ASSERT(bd->blocks < BLOCKS_PER_MBLOCK);
206     ln = log_2(bd->blocks);
207     
208     dbl_link_onto(bd, &free_list[ln]);
209 }
210
211
212 STATIC_INLINE bdescr *
213 tail_of (bdescr *bd)
214 {
215     return bd + bd->blocks - 1;
216 }
217
218 // After splitting a group, the last block of each group must have a
219 // tail that points to the head block, to keep our invariants for
220 // coalescing. 
221 STATIC_INLINE void
222 setup_tail (bdescr *bd)
223 {
224     bdescr *tail;
225     tail = tail_of(bd);
226     if (tail != bd) {
227         tail->blocks = 0;
228         tail->free = 0;
229         tail->link = bd;
230     }
231 }
232
233
234 // Take a free block group bd, and split off a group of size n from
235 // it.  Adjust the free list as necessary, and return the new group.
236 static bdescr *
237 split_free_block (bdescr *bd, nat n, nat ln)
238 {
239     bdescr *fg; // free group
240
241     ASSERT(bd->blocks > n);
242     dbl_link_remove(bd, &free_list[ln]);
243     fg = bd + bd->blocks - n; // take n blocks off the end
244     fg->blocks = n;
245     bd->blocks -= n;
246     setup_tail(bd);
247     ln = log_2(bd->blocks);
248     dbl_link_onto(bd, &free_list[ln]);
249     return fg;
250 }
251
252 static bdescr *
253 alloc_mega_group (nat mblocks)
254 {
255     bdescr *best, *bd, *prev;
256     nat n;
257
258     n = MBLOCK_GROUP_BLOCKS(mblocks);
259
260     best = NULL;
261     prev = NULL;
262     for (bd = free_mblock_list; bd != NULL; prev = bd, bd = bd->link)
263     {
264         if (bd->blocks == n) 
265         {
266             if (prev) {
267                 prev->link = bd->link;
268             } else {
269                 free_mblock_list = bd->link;
270             }
271             initGroup(bd);
272             return bd;
273         }
274         else if (bd->blocks > n)
275         {
276             if (!best || bd->blocks < best->blocks)
277             {
278                 best = bd;
279             }
280         }
281     }
282
283     if (best)
284     {
285         // we take our chunk off the end here.
286         nat best_mblocks  = BLOCKS_TO_MBLOCKS(best->blocks);
287         bd = FIRST_BDESCR(MBLOCK_ROUND_DOWN(best) + 
288                           (best_mblocks-mblocks)*MBLOCK_SIZE);
289
290         best->blocks = MBLOCK_GROUP_BLOCKS(best_mblocks - mblocks);
291         initMBlock(MBLOCK_ROUND_DOWN(bd));
292     }
293     else
294     {
295         void *mblock = getMBlocks(mblocks);
296         initMBlock(mblock);             // only need to init the 1st one
297         bd = FIRST_BDESCR(mblock);
298     }
299     bd->blocks = MBLOCK_GROUP_BLOCKS(mblocks);
300     return bd;
301 }
302
303 bdescr *
304 allocGroup (nat n)
305 {
306     bdescr *bd, *rem;
307     nat ln;
308
309     if (n == 0) barf("allocGroup: requested zero blocks");
310     
311     if (n >= BLOCKS_PER_MBLOCK)
312     {
313         nat mblocks;
314
315         mblocks = BLOCKS_TO_MBLOCKS(n);
316
317         // n_alloc_blocks doesn't count the extra blocks we get in a
318         // megablock group.
319         n_alloc_blocks += mblocks * BLOCKS_PER_MBLOCK;
320         if (n_alloc_blocks > hw_alloc_blocks) hw_alloc_blocks = n_alloc_blocks;
321
322         bd = alloc_mega_group(mblocks);
323         // only the bdescrs of the first MB are required to be initialised
324         initGroup(bd);
325
326         IF_DEBUG(sanity, checkFreeListSanity());
327         return bd;
328     }
329     
330     n_alloc_blocks += n;
331     if (n_alloc_blocks > hw_alloc_blocks) hw_alloc_blocks = n_alloc_blocks;
332
333     ln = log_2_ceil(n);
334
335     while (ln < MAX_FREE_LIST && free_list[ln] == NULL) {
336         ln++;
337     }
338
339     if (ln == MAX_FREE_LIST) {
340 #if 0
341         if ((mblocks_allocated * MBLOCK_SIZE_W - n_alloc_blocks * BLOCK_SIZE_W) > (1024*1024)/sizeof(W_)) {
342             debugBelch("Fragmentation, wanted %d blocks:", n);
343             RtsFlags.DebugFlags.block_alloc = 1;
344             checkFreeListSanity();
345         }
346 #endif
347
348         bd = alloc_mega_group(1);
349         bd->blocks = n;
350         initGroup(bd);                   // we know the group will fit
351         rem = bd + n;
352         rem->blocks = BLOCKS_PER_MBLOCK-n;
353         initGroup(rem); // init the slop
354         n_alloc_blocks += rem->blocks;
355         freeGroup(rem);                  // add the slop on to the free list
356         IF_DEBUG(sanity, checkFreeListSanity());
357         return bd;
358     }
359
360     bd = free_list[ln];
361
362     if (bd->blocks == n)                // exactly the right size!
363     {
364         dbl_link_remove(bd, &free_list[ln]);
365     }
366     else if (bd->blocks >  n)            // block too big...
367     {                              
368         bd = split_free_block(bd, n, ln);
369     }
370     else
371     {
372         barf("allocGroup: free list corrupted");
373     }
374     initGroup(bd);              // initialise it
375     IF_DEBUG(sanity, checkFreeListSanity());
376     ASSERT(bd->blocks == n);
377     return bd;
378 }
379
380 bdescr *
381 allocGroup_lock(nat n)
382 {
383     bdescr *bd;
384     ACQUIRE_SM_LOCK;
385     bd = allocGroup(n);
386     RELEASE_SM_LOCK;
387     return bd;
388 }
389
390 bdescr *
391 allocBlock(void)
392 {
393     return allocGroup(1);
394 }
395
396 bdescr *
397 allocBlock_lock(void)
398 {
399     bdescr *bd;
400     ACQUIRE_SM_LOCK;
401     bd = allocBlock();
402     RELEASE_SM_LOCK;
403     return bd;
404 }
405
406 /* -----------------------------------------------------------------------------
407    De-Allocation
408    -------------------------------------------------------------------------- */
409
410 STATIC_INLINE bdescr *
411 coalesce_mblocks (bdescr *p)
412 {
413     bdescr *q;
414
415     q = p->link;
416     if (q != NULL && 
417         MBLOCK_ROUND_DOWN(q) == 
418         MBLOCK_ROUND_DOWN(p) + BLOCKS_TO_MBLOCKS(p->blocks) * MBLOCK_SIZE) {
419         // can coalesce
420         p->blocks  = MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(p->blocks) +
421                                          BLOCKS_TO_MBLOCKS(q->blocks));
422         p->link = q->link;
423         return p;
424     }
425     return q;
426 }
427
428 static void
429 free_mega_group (bdescr *mg)
430 {
431     bdescr *bd, *prev;
432
433     // Find the right place in the free list.  free_mblock_list is
434     // sorted by *address*, not by size as the free_list is.
435     prev = NULL;
436     bd = free_mblock_list;
437     while (bd && bd->start < mg->start) {
438         prev = bd;
439         bd = bd->link;
440     }
441
442     // coalesce backwards
443     if (prev)
444     {
445         mg->link = prev->link;
446         prev->link = mg;
447         mg = coalesce_mblocks(prev);
448     }
449     else
450     {
451         mg->link = free_mblock_list;
452         free_mblock_list = mg;
453     }
454     // coalesce forwards
455     coalesce_mblocks(mg);
456
457     IF_DEBUG(sanity, checkFreeListSanity());
458 }    
459
460
461 void
462 freeGroup(bdescr *p)
463 {
464   nat ln;
465
466   // Todo: not true in multithreaded GC
467   // ASSERT_SM_LOCK();
468
469   ASSERT(p->free != (P_)-1);
470
471   p->free = (void *)-1;  /* indicates that this block is free */
472   p->step = NULL;
473   p->gen_no = 0;
474   /* fill the block group with garbage if sanity checking is on */
475   IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE));
476
477   if (p->blocks == 0) barf("freeGroup: block size is zero");
478
479   if (p->blocks >= BLOCKS_PER_MBLOCK)
480   {
481       nat mblocks;
482
483       mblocks = BLOCKS_TO_MBLOCKS(p->blocks);
484       // If this is an mgroup, make sure it has the right number of blocks
485       ASSERT(p->blocks == MBLOCK_GROUP_BLOCKS(mblocks));
486
487       n_alloc_blocks -= mblocks * BLOCKS_PER_MBLOCK;
488
489       free_mega_group(p);
490       return;
491   }
492
493   ASSERT(n_alloc_blocks >= p->blocks);
494   n_alloc_blocks -= p->blocks;
495
496   // coalesce forwards
497   {
498       bdescr *next;
499       next = p + p->blocks;
500       if (next <= LAST_BDESCR(MBLOCK_ROUND_DOWN(p)) && next->free == (P_)-1)
501       {
502           p->blocks += next->blocks;
503           ln = log_2(next->blocks);
504           dbl_link_remove(next, &free_list[ln]);
505           if (p->blocks == BLOCKS_PER_MBLOCK)
506           {
507               free_mega_group(p);
508               return;
509           }
510           setup_tail(p);
511       }
512   }
513
514   // coalesce backwards
515   if (p != FIRST_BDESCR(MBLOCK_ROUND_DOWN(p)))
516   {
517       bdescr *prev;
518       prev = p - 1;
519       if (prev->blocks == 0) prev = prev->link; // find the head
520
521       if (prev->free == (P_)-1)
522       {
523           ln = log_2(prev->blocks);
524           dbl_link_remove(prev, &free_list[ln]);
525           prev->blocks += p->blocks;
526           if (prev->blocks >= BLOCKS_PER_MBLOCK)
527           {
528               free_mega_group(prev);
529               return;
530           }
531           p = prev;
532       }
533   }
534       
535   setup_tail(p);
536   free_list_insert(p);
537
538   IF_DEBUG(sanity, checkFreeListSanity());
539 }
540
541 void
542 freeGroup_lock(bdescr *p)
543 {
544     ACQUIRE_SM_LOCK;
545     freeGroup(p);
546     RELEASE_SM_LOCK;
547 }
548
549 void
550 freeChain(bdescr *bd)
551 {
552   bdescr *next_bd;
553   while (bd != NULL) {
554     next_bd = bd->link;
555     freeGroup(bd);
556     bd = next_bd;
557   }
558 }
559
560 void
561 freeChain_lock(bdescr *bd)
562 {
563     ACQUIRE_SM_LOCK;
564     freeChain(bd);
565     RELEASE_SM_LOCK;
566 }
567
568 bdescr *
569 splitBlockGroup (bdescr *bd, nat blocks)
570 {
571     bdescr *new_bd;
572
573     if (bd->blocks <= blocks) {
574         barf("splitLargeBlock: too small");
575     }
576
577     if (bd->blocks > BLOCKS_PER_MBLOCK) {
578         nat mblocks;
579         void *new_mblock;
580         if ((blocks - BLOCKS_PER_MBLOCK) % (MBLOCK_SIZE / BLOCK_SIZE) != 0) {
581             barf("splitLargeBlock: not a multiple of a megablock");
582         }
583         mblocks = 1 + (blocks - BLOCKS_PER_MBLOCK) / (MBLOCK_SIZE / BLOCK_SIZE);
584         new_mblock = (void *) ((P_)MBLOCK_ROUND_DOWN(bd) + mblocks * MBLOCK_SIZE_W);
585         initMBlock(new_mblock);
586         new_bd = FIRST_BDESCR(new_mblock);
587         new_bd->blocks = MBLOCK_GROUP_BLOCKS(mblocks);
588     }
589     else
590     {
591         // NB. we're not updating all the bdescrs in the split groups to
592         // point to the new heads, so this can only be used for large
593         // objects which do not start in the non-head block.
594         new_bd = bd + blocks;
595         new_bd->blocks = bd->blocks - blocks;
596     }
597     bd->blocks = blocks;
598
599     return new_bd;
600 }
601
602 static void
603 initMBlock(void *mblock)
604 {
605   bdescr *bd;
606   void *block;
607
608   /* the first few Bdescr's in a block are unused, so we don't want to
609    * put them all on the free list.
610    */
611   block = FIRST_BLOCK(mblock);
612   bd    = FIRST_BDESCR(mblock);
613
614   /* Initialise the start field of each block descriptor
615    */
616   for (; block <= LAST_BLOCK(mblock); bd += 1, block += BLOCK_SIZE) {
617     bd->start = block;
618   }
619 }
620
621 /* -----------------------------------------------------------------------------
622    Debugging
623    -------------------------------------------------------------------------- */
624
625 #ifdef DEBUG
626 static void
627 check_tail (bdescr *bd)
628 {
629     bdescr *tail = tail_of(bd);
630
631     if (tail != bd)
632     {
633         ASSERT(tail->blocks == 0);
634         ASSERT(tail->free == 0);
635         ASSERT(tail->link == bd);
636     }
637 }
638
639 void
640 checkFreeListSanity(void)
641 {
642     bdescr *bd, *prev;
643     nat ln, min;
644
645
646     min = 1;
647     for (ln = 0; ln < MAX_FREE_LIST; ln++) {
648         IF_DEBUG(block_alloc, debugBelch("free block list [%d]:\n", ln));
649
650         prev = NULL;
651         for (bd = free_list[ln]; bd != NULL; prev = bd, bd = bd->link)
652         {
653             IF_DEBUG(block_alloc,
654                      debugBelch("group at %p, length %ld blocks\n", 
655                                 bd->start, (long)bd->blocks));
656             ASSERT(bd->free == (P_)-1);
657             ASSERT(bd->blocks > 0 && bd->blocks < BLOCKS_PER_MBLOCK);
658             ASSERT(bd->blocks >= min && bd->blocks <= (min*2 - 1));
659             ASSERT(bd->link != bd); // catch easy loops
660
661             check_tail(bd);
662
663             if (prev)
664                 ASSERT(bd->u.back == prev);
665             else 
666                 ASSERT(bd->u.back == NULL);
667
668             {
669                 bdescr *next;
670                 next = bd + bd->blocks;
671                 if (next <= LAST_BDESCR(MBLOCK_ROUND_DOWN(bd)))
672                 {
673                     ASSERT(next->free != (P_)-1);
674                 }
675             }
676         }
677         min = min << 1;
678     }
679
680     prev = NULL;
681     for (bd = free_mblock_list; bd != NULL; prev = bd, bd = bd->link)
682     {
683         IF_DEBUG(block_alloc,
684                  debugBelch("mega group at %p, length %ld blocks\n", 
685                             bd->start, (long)bd->blocks));
686
687         ASSERT(bd->link != bd); // catch easy loops
688
689         if (bd->link != NULL)
690         {
691             // make sure the list is sorted
692             ASSERT(bd->start < bd->link->start);
693         }
694
695         ASSERT(bd->blocks >= BLOCKS_PER_MBLOCK);
696         ASSERT(MBLOCK_GROUP_BLOCKS(BLOCKS_TO_MBLOCKS(bd->blocks))
697                == bd->blocks);
698
699         // make sure we're fully coalesced
700         if (bd->link != NULL)
701         {
702             ASSERT (MBLOCK_ROUND_DOWN(bd->link) != 
703                     MBLOCK_ROUND_DOWN(bd) + 
704                     BLOCKS_TO_MBLOCKS(bd->blocks) * MBLOCK_SIZE);
705         }
706     }
707 }
708
709 nat /* BLOCKS */
710 countFreeList(void)
711 {
712   bdescr *bd;
713   lnat total_blocks = 0;
714   nat ln;
715
716   for (ln=0; ln < MAX_FREE_LIST; ln++) {
717       for (bd = free_list[ln]; bd != NULL; bd = bd->link) {
718           total_blocks += bd->blocks;
719       }
720   }
721   for (bd = free_mblock_list; bd != NULL; bd = bd->link) {
722       total_blocks += BLOCKS_PER_MBLOCK * BLOCKS_TO_MBLOCKS(bd->blocks);
723       // The caller of this function, memInventory(), expects to match
724       // the total number of blocks in the system against mblocks *
725       // BLOCKS_PER_MBLOCK, so we must subtract the space for the
726       // block descriptors from *every* mblock.
727   }
728   return total_blocks;
729 }
730 #endif