1 /* -----------------------------------------------------------------------------
2 * $Id: Storage.c,v 1.7 1999/01/26 16:16:30 simonm Exp $
4 * Storage manager front end
6 * ---------------------------------------------------------------------------*/
13 #include "BlockAlloc.h"
19 #include "StoragePriv.h"
21 bdescr *current_nursery; /* next available nursery block, or NULL */
22 nat nursery_blocks; /* number of blocks in the nursery */
24 StgClosure *caf_list = NULL;
26 bdescr *small_alloc_list; /* allocate()d small objects */
27 bdescr *large_alloc_list; /* allocate()d large objects */
28 nat alloc_blocks; /* number of allocate()d blocks since GC */
29 nat alloc_blocks_lim; /* approximate limit on alloc_blocks */
31 StgPtr alloc_Hp = NULL; /* next free byte in small_alloc_list */
32 StgPtr alloc_HpLim = NULL; /* end of block at small_alloc_list */
34 generation *generations; /* all the generations */
35 generation *g0; /* generation 0, for convenience */
36 generation *oldest_gen; /* oldest generation, for convenience */
37 step *g0s0; /* generation 0, step 0, for convenience */
42 static void *stgAllocForGMP (size_t size_in_bytes);
43 static void *stgReallocForGMP (void *ptr, size_t old_size, size_t new_size);
44 static void stgDeallocForGMP (void *ptr, size_t size);
55 /* allocate generation info array */
56 generations = (generation *)stgMallocBytes(RtsFlags.GcFlags.generations
57 * sizeof(struct _generation),
60 /* Initialise all generations */
61 for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
62 gen = &generations[g];
64 gen->mut_list = END_MUT_LIST;
66 gen->failed_promotions = 0;
67 gen->max_blocks = RtsFlags.GcFlags.minOldGenSize;
70 /* A couple of convenience pointers */
72 oldest_gen = &generations[RtsFlags.GcFlags.generations-1];
74 /* Allocate step structures in each generation */
75 if (RtsFlags.GcFlags.generations > 1) {
76 /* Only for multiple-generations */
78 /* Oldest generation: one step */
79 oldest_gen->n_steps = 1;
81 stgMallocBytes(1 * sizeof(struct _step), "initStorage: last step");
83 /* set up all except the oldest generation with 2 steps */
84 for(g = 0; g < RtsFlags.GcFlags.generations-1; g++) {
85 generations[g].n_steps = RtsFlags.GcFlags.steps;
86 generations[g].steps =
87 stgMallocBytes (RtsFlags.GcFlags.steps * sizeof(struct _step),
88 "initStorage: steps");
92 /* single generation, i.e. a two-space collector */
94 g0->steps = stgMallocBytes (sizeof(struct _step), "initStorage: steps");
97 /* Initialise all steps */
98 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
99 for (s = 0; s < generations[g].n_steps; s++) {
100 step = &generations[g].steps[s];
104 step->gen = &generations[g];
108 step->large_objects = NULL;
109 step->new_large_objects = NULL;
110 step->scavenged_large_objects = NULL;
114 /* Set up the destination pointers in each younger gen. step */
115 for (g = 0; g < RtsFlags.GcFlags.generations-1; g++) {
116 for (s = 0; s < generations[g].n_steps-1; s++) {
117 generations[g].steps[s].to = &generations[g].steps[s+1];
119 generations[g].steps[s].to = &generations[g+1].steps[0];
122 /* The oldest generation has one step and its destination is the
124 oldest_gen->steps[0].to = &oldest_gen->steps[0];
126 /* generation 0 is special: that's the nursery */
127 generations[0].max_blocks = 0;
129 /* G0S0: the allocation area */
130 step = &generations[0].steps[0];
132 step->blocks = allocNursery(NULL, RtsFlags.GcFlags.minAllocAreaSize);
133 step->n_blocks = RtsFlags.GcFlags.minAllocAreaSize;
134 nursery_blocks = RtsFlags.GcFlags.minAllocAreaSize;
135 current_nursery = step->blocks;
136 /* hp, hpLim, hp_bd, to_space etc. aren't used in G0S0 */
138 weak_ptr_list = NULL;
141 /* initialise the allocate() interface */
142 small_alloc_list = NULL;
143 large_alloc_list = NULL;
145 alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
148 /* Tell GNU multi-precision pkg about our custom alloc functions */
149 mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
152 IF_DEBUG(gc, stat_describe_gens());
156 allocNursery (bdescr *last_bd, nat blocks)
161 /* Allocate a nursery */
162 for (i=0; i < blocks; i++) {
168 bd->free = bd->start;
180 /* Return code ignored for now */
181 /* ToDo: allocation figure is slightly wrong (see also GarbageCollect()) */
182 allocated = (nursery_blocks * BLOCK_SIZE_W) + allocated_bytes();
183 for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
184 allocated -= BLOCK_SIZE_W;
186 stat_exit(allocated);
190 recordMutable(StgMutClosure *p)
194 ASSERT(closure_MUTABLE(p));
198 /* no need to bother in generation 0 */
203 if (p->mut_link == NULL) {
204 p->mut_link = bd->gen->mut_list;
205 bd->gen->mut_list = p;
210 newCAF(StgClosure* caf)
212 /* Put this CAF on the mutable list for the old generation.
213 * This is a HACK - the IND_STATIC closure doesn't really have
214 * a mut_link field, but we pretend it has - in fact we re-use
215 * the STATIC_LINK field for the time being, because when we
216 * come to do a major GC we won't need the mut_link field
217 * any more and can use it as a STATIC_LINK.
219 ((StgMutClosure *)caf)->mut_link = oldest_gen->mut_list;
220 oldest_gen->mut_list = (StgMutClosure *)caf;
224 const StgInfoTable *info;
226 info = get_itbl(caf);
227 ASSERT(info->type == IND_STATIC);
228 STATIC_LINK2(info,caf) = caf_list;
234 /* -----------------------------------------------------------------------------
235 The allocate() interface
237 allocate(n) always succeeds, and returns a chunk of memory n words
238 long. n can be larger than the size of a block if necessary, in
239 which case a contiguous block group will be allocated.
240 -------------------------------------------------------------------------- */
251 /* big allocation (>LARGE_OBJECT_THRESHOLD) */
252 /* ToDo: allocate directly into generation 1 */
253 if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
254 nat req_blocks = (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
255 bd = allocGroup(req_blocks);
256 dbl_link_onto(bd, &g0s0->large_objects);
260 bd->free = bd->start;
261 /* don't add these blocks to alloc_blocks, since we're assuming
262 * that large objects are likely to remain live for quite a while
263 * (eg. running threads), so garbage collecting early won't make
268 /* small allocation (<LARGE_OBJECT_THRESHOLD) */
269 } else if (small_alloc_list == NULL || alloc_Hp + n > alloc_HpLim) {
270 if (small_alloc_list) {
271 small_alloc_list->free = alloc_Hp;
274 bd->link = small_alloc_list;
275 small_alloc_list = bd;
279 alloc_Hp = bd->start;
280 alloc_HpLim = bd->start + BLOCK_SIZE_W;
289 lnat allocated_bytes(void)
291 return (alloc_blocks * BLOCK_SIZE_W - (alloc_HpLim - alloc_Hp));
294 /* -----------------------------------------------------------------------------
295 Allocation functions for GMP.
297 These all use the allocate() interface - we can't have any garbage
298 collection going on during a gmp operation, so we use allocate()
299 which always succeeds. The gmp operations which might need to
300 allocate will ask the storage manager (via doYouWantToGC()) whether
301 a garbage collection is required, in case we get into a loop doing
302 only allocate() style allocation.
303 -------------------------------------------------------------------------- */
306 stgAllocForGMP (size_t size_in_bytes)
309 nat data_size_in_words, total_size_in_words;
311 /* should be a multiple of sizeof(StgWord) (whole no. of limbs) */
312 ASSERT(size_in_bytes % sizeof(W_) == 0);
314 data_size_in_words = size_in_bytes / sizeof(W_);
315 total_size_in_words = sizeofW(StgArrWords) + data_size_in_words;
317 /* allocate and fill it in. */
318 arr = (StgArrWords *)allocate(total_size_in_words);
319 SET_ARR_HDR(arr, &ARR_WORDS_info, CCCS, data_size_in_words);
321 /* and return a ptr to the goods inside the array */
322 return(BYTE_ARR_CTS(arr));
326 stgReallocForGMP (void *ptr, size_t old_size, size_t new_size)
328 void *new_stuff_ptr = stgAllocForGMP(new_size);
330 char *p = (char *) ptr;
331 char *q = (char *) new_stuff_ptr;
333 for (; i < old_size; i++, p++, q++) {
337 return(new_stuff_ptr);
341 stgDeallocForGMP (void *ptr STG_UNUSED,
342 size_t size STG_UNUSED)
344 /* easy for us: the garbage collector does the dealloc'n */
347 /* -----------------------------------------------------------------------------
350 memInventory() checks for memory leaks by counting up all the
351 blocks we know about and comparing that to the number of blocks
352 allegedly floating around in the system.
353 -------------------------------------------------------------------------- */
363 lnat total_blocks = 0, free_blocks = 0;
365 /* count the blocks we current have */
367 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
368 for (s = 0; s < generations[g].n_steps; s++) {
369 step = &generations[g].steps[s];
370 total_blocks += step->n_blocks;
371 if (RtsFlags.GcFlags.generations == 1) {
372 /* two-space collector has a to-space too :-) */
373 total_blocks += g0s0->to_blocks;
375 for (bd = step->large_objects; bd; bd = bd->link) {
376 total_blocks += bd->blocks;
377 /* hack for megablock groups: they have an extra block or two in
378 the second and subsequent megablocks where the block
379 descriptors would normally go.
381 if (bd->blocks > BLOCKS_PER_MBLOCK) {
382 total_blocks -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK)
383 * bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE);
389 /* any blocks held by allocate() */
390 for (bd = small_alloc_list; bd; bd = bd->link) {
391 total_blocks += bd->blocks;
393 for (bd = large_alloc_list; bd; bd = bd->link) {
394 total_blocks += bd->blocks;
397 /* count the blocks on the free list */
398 free_blocks = countFreeList();
400 ASSERT(total_blocks + free_blocks == mblocks_allocated * BLOCKS_PER_MBLOCK);
403 if (total_blocks + free_blocks != mblocks_allocated *
405 fprintf(stderr, "Blocks: %ld live + %ld free = %ld total (%ld around)\n",
406 total_blocks, free_blocks, total_blocks + free_blocks,
407 mblocks_allocated * BLOCKS_PER_MBLOCK);