[project @ 1999-01-13 17:25:37 by simonm]
[ghc-hetmet.git] / ghc / rts / BlockAlloc.c
1 /* -----------------------------------------------------------------------------
2  * $Id: BlockAlloc.c,v 1.3 1999/01/13 17:25:37 simonm Exp $
3  *
4  * The block allocator and free list manager.
5  *
6  * This is the architecture independent part of the block allocator.
7  * It requires only the following support from the operating system: 
8  *
9  *    void *getMBlock();
10  *
11  * returns the address of an MBLOCK_SIZE region of memory, aligned on
12  * an MBLOCK_SIZE boundary.  There is no requirement for successive
13  * calls to getMBlock to return strictly increasing addresses.
14  *
15  * ---------------------------------------------------------------------------*/
16
17 #include "Rts.h"
18 #include "RtsFlags.h"
19 #include "RtsUtils.h"
20 #include "BlockAlloc.h"
21 #include "MBlock.h"
22
23 static void    initMBlock(void *mblock);
24 static bdescr *allocMegaGroup(nat mblocks);
25 static void    freeMegaGroup(bdescr *bd);
26
27 static bdescr *free_list;
28
29 /* -----------------------------------------------------------------------------
30    Initialisation
31    -------------------------------------------------------------------------- */
32
33 void initBlockAllocator(void)
34 {
35   free_list = NULL;
36 }
37
38 /* -----------------------------------------------------------------------------
39    Allocation
40    -------------------------------------------------------------------------- */
41
42 static inline void
43 initGroup(nat n, bdescr *head)
44 {
45   bdescr *bd;
46   nat i;
47
48   if (n != 0) {
49     head->blocks = n;
50     head->free = head->start;
51     for (i=1, bd = head+1; i < n; i++, bd++) {
52       bd->free = 0;
53       bd->link = head;
54     }
55   }
56 }
57
58 bdescr *
59 allocGroup(nat n)
60 {
61   void *mblock;
62   bdescr *bd, **last;
63
64   if (n > BLOCKS_PER_MBLOCK) {
65     return allocMegaGroup(BLOCKS_TO_MBLOCKS(n));
66   }
67
68   last = &free_list;
69   for (bd = free_list; bd != NULL; bd = bd->link) {
70     if (bd->blocks == n) {      /* exactly the right size! */
71       *last = bd->link;
72       /* no initialisation necessary - this is already a
73        * self-contained block group. */
74       return bd;
75     }
76     if (bd->blocks >  n) {      /* block too big... */
77       bd->blocks -= n;          /* take a chunk off the *end* */
78       bd += bd->blocks;
79       initGroup(n, bd);         /* initialise it */
80       return bd;
81     }
82     last = &bd->link;
83   }
84   
85   mblock = getMBlock();         /* get a new megablock */
86   initMBlock(mblock);           /* initialise the start fields */
87   bd = FIRST_BDESCR(mblock);
88   initGroup(n,bd);              /* we know the group will fit */
89   initGroup(BLOCKS_PER_MBLOCK-n, bd+n);
90   freeGroup(bd+n);              /* add the rest on to the free list */
91   return bd;
92 }
93
94 bdescr *
95 allocBlock(void)
96 {
97   return allocGroup(1);
98 }
99
100 /* -----------------------------------------------------------------------------
101    Any request larger than BLOCKS_PER_MBLOCK needs a megablock group.
102    First, search the free list for enough contiguous megablocks to
103    fulfill the request - if we don't have enough, we need to
104    allocate some new ones.
105
106    A megablock group looks just like a normal block group, except that
107    the blocks field in the head will be larger than BLOCKS_PER_MBLOCK.
108
109    Note that any objects placed in this group must start in the first
110    megablock, since the other blocks don't have block descriptors.
111    -------------------------------------------------------------------------- */
112    
113 static bdescr *
114 allocMegaGroup(nat n)
115 {
116   nat mbs_found;
117   bdescr *bd, *last, *grp_start, *grp_prev;
118
119   mbs_found = 0;
120   grp_start = NULL;
121   grp_prev  = NULL;
122   last      = NULL;
123   for (bd = free_list; bd != NULL; bd = bd->link) {
124
125     if (bd->blocks == BLOCKS_PER_MBLOCK) {      /* whole megablock found */
126
127       if (grp_start == NULL) {  /* is it the first one we've found? */
128         grp_start = bd;
129         grp_prev  = last;
130         mbs_found = 1;
131       } else {
132         mbs_found++;
133       }
134
135       if (mbs_found == n) {     /* found enough contig megablocks? */
136         break;
137       }
138     } 
139
140     else {                      /* only a partial megablock, start again */
141       grp_start = NULL;
142     }
143
144     last = bd;
145   }
146
147   /* found all the megablocks we need on the free list
148    */
149   if (mbs_found == n) {
150     /* remove the megablocks from the free list */
151     if (grp_prev == NULL) {     /* bd now points to the last mblock */
152       free_list = bd->link;
153     } else {
154       grp_prev->link = bd->link;
155     }
156   }
157
158   /* the free list wasn't sufficient, allocate all new mblocks.
159    */
160   else {
161     void *mblock = getMBlocks(n);
162     initMBlock(mblock);         /* only need to init the 1st one */
163     grp_start = FIRST_BDESCR(mblock);
164   }
165
166   /* set up the megablock group */
167   initGroup(BLOCKS_PER_MBLOCK, grp_start);
168   grp_start->blocks = MBLOCK_GROUP_BLOCKS(n);
169   return grp_start;
170 }
171
172 /* -----------------------------------------------------------------------------
173    De-Allocation
174    -------------------------------------------------------------------------- */
175
176 /* coalesce the group p with p->link if possible.
177  *
178  * Returns p->link if no coalescing was done, otherwise returns a
179  * pointer to the newly enlarged group p.
180  */
181
182 static inline bdescr *
183 coalesce(bdescr *p)
184 {
185   bdescr *bd, *q;
186   nat i;
187
188   q = p->link;
189   if (q != NULL && p->start + p->blocks * BLOCK_SIZE_W == q->start) {
190     /* can coalesce */
191     p->blocks += q->blocks;
192     p->link    = q->link;
193     for (i = 0, bd = q; i < q->blocks; bd++, i++) {
194         bd->free = 0;
195         bd->link = p;
196     }
197     return p;
198   }
199   return q;
200 }
201
202 void
203 freeGroup(bdescr *p)
204 {
205   bdescr *bd, *last;
206   
207   /* are we dealing with a megablock group? */
208   if (p->blocks > BLOCKS_PER_MBLOCK) {
209     freeMegaGroup(p);
210     return;
211   }
212
213 #ifdef DEBUG
214   p->free = (void *)-1;  /* indicates that this block is free */
215   p->step = NULL;
216   p->gen  = NULL;
217   /* fill the block group with garbage if sanity checking is on */
218   IF_DEBUG(sanity,memset(p->start, 0xaa, p->blocks * BLOCK_SIZE));
219 #endif
220
221   /* find correct place in free list to place new group */
222   last = NULL;
223   for (bd = free_list; bd != NULL && bd->start < p->start; 
224        bd = bd->link) {
225     last = bd;
226   }
227
228   /* now, last = previous group (or NULL) */
229   if (last == NULL) {
230     p->link = free_list;
231     free_list = p;
232   } else {
233     /* coalesce with previous group if possible */
234     p->link = last->link;
235     last->link = p;
236     p = coalesce(last);
237   }
238
239   /* coalesce with next group if possible */
240   coalesce(p);
241   IF_DEBUG(sanity, checkFreeListSanity());
242 }
243
244 static void
245 freeMegaGroup(bdescr *p)
246 {
247   nat n;
248
249   n = p->blocks * BLOCK_SIZE / MBLOCK_SIZE + 1;
250   for (; n > 0; (W_)p += MBLOCK_SIZE, n--) {
251     initMBlock((void *)((W_)p & ~MBLOCK_MASK));
252     initGroup(BLOCKS_PER_MBLOCK, p);
253     freeGroup(p);
254   }
255 }
256
257 void
258 freeChain(bdescr *bd)
259 {
260   bdescr *next_bd;
261   while (bd != NULL) {
262     next_bd = bd->link;
263     freeGroup(bd);
264     bd = next_bd;
265   }
266 }
267
268 static void
269 initMBlock(void *mblock)
270 {
271   bdescr *bd;
272   void *block;
273
274   /* the first few Bdescr's in a block are unused, so we don't want to
275    * put them all on the free list.
276    */
277   block = FIRST_BLOCK(mblock);
278   bd    = FIRST_BDESCR(mblock);
279
280   /* Initialise the start field of each block descriptor
281    */
282   for (; block <= LAST_BLOCK(mblock); bd += 1, (lnat)block += BLOCK_SIZE) {
283     bd->start = block;
284   }
285 }
286
287 /* -----------------------------------------------------------------------------
288    Debugging
289    -------------------------------------------------------------------------- */
290
291 #ifdef DEBUG
292 void
293 checkFreeListSanity(void)
294 {
295   bdescr *bd;
296
297   for (bd = free_list; bd != NULL; bd = bd->link) {
298     IF_DEBUG(block_alloc,
299              fprintf(stderr,"group at 0x%x, length %d blocks\n", 
300                      (nat)bd->start, bd->blocks));
301     ASSERT(bd->blocks > 0);
302     if (bd->link != NULL) {
303       /* make sure we're fully coalesced */
304       ASSERT(bd->start + bd->blocks * BLOCK_SIZE_W != bd->link->start);
305       ASSERT(bd->start < bd->link->start);
306     }
307   }
308 }
309
310 nat /* BLOCKS */
311 countFreeList(void)
312 {
313   bdescr *bd;
314   lnat total_blocks = 0;
315
316   for (bd = free_list; bd != NULL; bd = bd->link) {
317     total_blocks += bd->blocks;
318   }
319   return total_blocks;
320 }
321 #endif