1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 1998-2004
5 * Storage manager front end
7 * ---------------------------------------------------------------------------*/
9 #include "PosixSource.h"
15 #include "BlockAlloc.h"
20 #include "OSThreads.h"
21 #include "Capability.h"
24 #include "RetainerProfile.h" // for counting memory blocks (memInventory)
32 * All these globals require sm_mutex to access in THREADED_RTS mode.
34 StgClosure *caf_list = NULL;
35 StgClosure *revertible_caf_list = NULL;
38 bdescr *small_alloc_list; /* allocate()d small objects */
39 bdescr *pinned_object_block; /* allocate pinned objects into this block */
40 nat alloc_blocks; /* number of allocate()d blocks since GC */
41 nat alloc_blocks_lim; /* approximate limit on alloc_blocks */
43 StgPtr alloc_Hp = NULL; /* next free byte in small_alloc_list */
44 StgPtr alloc_HpLim = NULL; /* end of block at small_alloc_list */
46 generation *generations = NULL; /* all the generations */
47 generation *g0 = NULL; /* generation 0, for convenience */
48 generation *oldest_gen = NULL; /* oldest generation, for convenience */
49 step *g0s0 = NULL; /* generation 0, step 0, for convenience */
51 ullong total_allocated = 0; /* total memory allocated during run */
53 nat n_nurseries = 0; /* == RtsFlags.ParFlags.nNodes, convenience */
54 step *nurseries = NULL; /* array of nurseries, >1 only if THREADED_RTS */
58 * Storage manager mutex: protects all the above state from
59 * simultaneous access by two STG threads.
63 * This mutex is used by atomicModifyMutVar# only
65 Mutex atomic_modify_mutvar_mutex;
72 static void *stgAllocForGMP (size_t size_in_bytes);
73 static void *stgReallocForGMP (void *ptr, size_t old_size, size_t new_size);
74 static void stgDeallocForGMP (void *ptr, size_t size);
77 initStep (step *stp, int g, int s)
82 stp->old_blocks = NULL;
83 stp->n_old_blocks = 0;
84 stp->gen = &generations[g];
90 stp->scavd_hpLim = NULL;
93 stp->large_objects = NULL;
94 stp->n_large_blocks = 0;
95 stp->new_large_objects = NULL;
96 stp->scavenged_large_objects = NULL;
97 stp->n_scavenged_large_blocks = 0;
98 stp->is_compacted = 0;
108 if (generations != NULL) {
109 // multi-init protection
113 /* Sanity check to make sure the LOOKS_LIKE_ macros appear to be
114 * doing something reasonable.
116 ASSERT(LOOKS_LIKE_INFO_PTR(&stg_BLACKHOLE_info));
117 ASSERT(LOOKS_LIKE_CLOSURE_PTR(&stg_dummy_ret_closure));
118 ASSERT(!HEAP_ALLOCED(&stg_dummy_ret_closure));
120 if (RtsFlags.GcFlags.maxHeapSize != 0 &&
121 RtsFlags.GcFlags.heapSizeSuggestion >
122 RtsFlags.GcFlags.maxHeapSize) {
123 RtsFlags.GcFlags.maxHeapSize = RtsFlags.GcFlags.heapSizeSuggestion;
126 if (RtsFlags.GcFlags.maxHeapSize != 0 &&
127 RtsFlags.GcFlags.minAllocAreaSize >
128 RtsFlags.GcFlags.maxHeapSize) {
129 errorBelch("maximum heap size (-M) is smaller than minimum alloc area size (-A)");
133 initBlockAllocator();
135 #if defined(THREADED_RTS)
136 initMutex(&sm_mutex);
137 initMutex(&atomic_modify_mutvar_mutex);
142 /* allocate generation info array */
143 generations = (generation *)stgMallocBytes(RtsFlags.GcFlags.generations
144 * sizeof(struct generation_),
145 "initStorage: gens");
147 /* Initialise all generations */
148 for(g = 0; g < RtsFlags.GcFlags.generations; g++) {
149 gen = &generations[g];
151 gen->mut_list = allocBlock();
152 gen->collections = 0;
153 gen->failed_promotions = 0;
157 /* A couple of convenience pointers */
158 g0 = &generations[0];
159 oldest_gen = &generations[RtsFlags.GcFlags.generations-1];
161 /* Allocate step structures in each generation */
162 if (RtsFlags.GcFlags.generations > 1) {
163 /* Only for multiple-generations */
165 /* Oldest generation: one step */
166 oldest_gen->n_steps = 1;
168 stgMallocBytes(1 * sizeof(struct step_), "initStorage: last step");
170 /* set up all except the oldest generation with 2 steps */
171 for(g = 0; g < RtsFlags.GcFlags.generations-1; g++) {
172 generations[g].n_steps = RtsFlags.GcFlags.steps;
173 generations[g].steps =
174 stgMallocBytes (RtsFlags.GcFlags.steps * sizeof(struct step_),
175 "initStorage: steps");
179 /* single generation, i.e. a two-space collector */
181 g0->steps = stgMallocBytes (sizeof(struct step_), "initStorage: steps");
185 n_nurseries = n_capabilities;
186 nurseries = stgMallocBytes (n_nurseries * sizeof(struct step_),
187 "initStorage: nurseries");
190 nurseries = g0->steps; // just share nurseries[0] with g0s0
193 /* Initialise all steps */
194 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
195 for (s = 0; s < generations[g].n_steps; s++) {
196 initStep(&generations[g].steps[s], g, s);
201 for (s = 0; s < n_nurseries; s++) {
202 initStep(&nurseries[s], 0, s);
206 /* Set up the destination pointers in each younger gen. step */
207 for (g = 0; g < RtsFlags.GcFlags.generations-1; g++) {
208 for (s = 0; s < generations[g].n_steps-1; s++) {
209 generations[g].steps[s].to = &generations[g].steps[s+1];
211 generations[g].steps[s].to = &generations[g+1].steps[0];
213 oldest_gen->steps[0].to = &oldest_gen->steps[0];
216 for (s = 0; s < n_nurseries; s++) {
217 nurseries[s].to = generations[0].steps[0].to;
221 /* The oldest generation has one step. */
222 if (RtsFlags.GcFlags.compact) {
223 if (RtsFlags.GcFlags.generations == 1) {
224 errorBelch("WARNING: compaction is incompatible with -G1; disabled");
226 oldest_gen->steps[0].is_compacted = 1;
231 if (RtsFlags.GcFlags.generations == 1) {
232 errorBelch("-G1 is incompatible with -threaded");
233 stg_exit(EXIT_FAILURE);
237 /* generation 0 is special: that's the nursery */
238 generations[0].max_blocks = 0;
240 /* G0S0: the allocation area. Policy: keep the allocation area
241 * small to begin with, even if we have a large suggested heap
242 * size. Reason: we're going to do a major collection first, and we
243 * don't want it to be a big one. This vague idea is borne out by
244 * rigorous experimental evidence.
246 g0s0 = &generations[0].steps[0];
250 weak_ptr_list = NULL;
252 revertible_caf_list = NULL;
254 /* initialise the allocate() interface */
255 small_alloc_list = NULL;
257 alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
259 /* Tell GNU multi-precision pkg about our custom alloc functions */
260 mp_set_memory_functions(stgAllocForGMP, stgReallocForGMP, stgDeallocForGMP);
262 IF_DEBUG(gc, statDescribeGens());
270 stat_exit(calcAllocated());
279 /* -----------------------------------------------------------------------------
282 The entry code for every CAF does the following:
284 - builds a CAF_BLACKHOLE in the heap
285 - pushes an update frame pointing to the CAF_BLACKHOLE
286 - invokes UPD_CAF(), which:
287 - calls newCaf, below
288 - updates the CAF with a static indirection to the CAF_BLACKHOLE
290 Why do we build a BLACKHOLE in the heap rather than just updating
291 the thunk directly? It's so that we only need one kind of update
292 frame - otherwise we'd need a static version of the update frame too.
294 newCaf() does the following:
296 - it puts the CAF on the oldest generation's mut-once list.
297 This is so that we can treat the CAF as a root when collecting
300 For GHCI, we have additional requirements when dealing with CAFs:
302 - we must *retain* all dynamically-loaded CAFs ever entered,
303 just in case we need them again.
304 - we must be able to *revert* CAFs that have been evaluated, to
305 their pre-evaluated form.
307 To do this, we use an additional CAF list. When newCaf() is
308 called on a dynamically-loaded CAF, we add it to the CAF list
309 instead of the old-generation mutable list, and save away its
310 old info pointer (in caf->saved_info) for later reversion.
312 To revert all the CAFs, we traverse the CAF list and reset the
313 info pointer to caf->saved_info, then throw away the CAF list.
314 (see GC.c:revertCAFs()).
318 -------------------------------------------------------------------------- */
321 newCAF(StgClosure* caf)
328 // If we are in GHCi _and_ we are using dynamic libraries,
329 // then we can't redirect newCAF calls to newDynCAF (see below),
330 // so we make newCAF behave almost like newDynCAF.
331 // The dynamic libraries might be used by both the interpreted
332 // program and GHCi itself, so they must not be reverted.
333 // This also means that in GHCi with dynamic libraries, CAFs are not
334 // garbage collected. If this turns out to be a problem, we could
335 // do another hack here and do an address range test on caf to figure
336 // out whether it is from a dynamic library.
337 ((StgIndStatic *)caf)->saved_info = (StgInfoTable *)caf->header.info;
338 ((StgIndStatic *)caf)->static_link = caf_list;
343 /* Put this CAF on the mutable list for the old generation.
344 * This is a HACK - the IND_STATIC closure doesn't really have
345 * a mut_link field, but we pretend it has - in fact we re-use
346 * the STATIC_LINK field for the time being, because when we
347 * come to do a major GC we won't need the mut_link field
348 * any more and can use it as a STATIC_LINK.
350 ((StgIndStatic *)caf)->saved_info = NULL;
351 recordMutableGen(caf, oldest_gen);
357 /* If we are PAR or DIST then we never forget a CAF */
359 //debugBelch("<##> Globalising CAF %08x %s",caf,info_type(caf));
360 newGA=makeGlobal(caf,rtsTrue); /*given full weight*/
366 // An alternate version of newCaf which is used for dynamically loaded
367 // object code in GHCi. In this case we want to retain *all* CAFs in
368 // the object code, because they might be demanded at any time from an
369 // expression evaluated on the command line.
370 // Also, GHCi might want to revert CAFs, so we add these to the
371 // revertible_caf_list.
373 // The linker hackily arranges that references to newCaf from dynamic
374 // code end up pointing to newDynCAF.
376 newDynCAF(StgClosure *caf)
380 ((StgIndStatic *)caf)->saved_info = (StgInfoTable *)caf->header.info;
381 ((StgIndStatic *)caf)->static_link = revertible_caf_list;
382 revertible_caf_list = caf;
387 /* -----------------------------------------------------------------------------
389 -------------------------------------------------------------------------- */
392 allocNursery (step *stp, bdescr *tail, nat blocks)
397 // Allocate a nursery: we allocate fresh blocks one at a time and
398 // cons them on to the front of the list, not forgetting to update
399 // the back pointer on the tail of the list to point to the new block.
400 for (i=0; i < blocks; i++) {
403 processNursery() in LdvProfile.c assumes that every block group in
404 the nursery contains only a single block. So, if a block group is
405 given multiple blocks, change processNursery() accordingly.
409 // double-link the nursery: we might need to insert blocks
416 bd->free = bd->start;
424 assignNurseriesToCapabilities (void)
429 for (i = 0; i < n_nurseries; i++) {
430 capabilities[i].r.rNursery = &nurseries[i];
431 capabilities[i].r.rCurrentNursery = nurseries[i].blocks;
432 capabilities[i].r.rCurrentAlloc = NULL;
434 #else /* THREADED_RTS */
435 MainCapability.r.rNursery = &nurseries[0];
436 MainCapability.r.rCurrentNursery = nurseries[0].blocks;
437 MainCapability.r.rCurrentAlloc = NULL;
442 allocNurseries( void )
446 for (i = 0; i < n_nurseries; i++) {
447 nurseries[i].blocks =
448 allocNursery(&nurseries[i], NULL,
449 RtsFlags.GcFlags.minAllocAreaSize);
450 nurseries[i].n_blocks = RtsFlags.GcFlags.minAllocAreaSize;
451 nurseries[i].old_blocks = NULL;
452 nurseries[i].n_old_blocks = 0;
453 /* hp, hpLim, hp_bd, to_space etc. aren't used in the nursery */
455 assignNurseriesToCapabilities();
459 resetNurseries( void )
465 for (i = 0; i < n_nurseries; i++) {
467 for (bd = stp->blocks; bd; bd = bd->link) {
468 bd->free = bd->start;
469 ASSERT(bd->gen_no == 0);
470 ASSERT(bd->step == stp);
471 IF_DEBUG(sanity,memset(bd->start, 0xaa, BLOCK_SIZE));
474 assignNurseriesToCapabilities();
478 countNurseryBlocks (void)
483 for (i = 0; i < n_nurseries; i++) {
484 blocks += nurseries[i].n_blocks;
490 resizeNursery ( step *stp, nat blocks )
495 nursery_blocks = stp->n_blocks;
496 if (nursery_blocks == blocks) return;
498 if (nursery_blocks < blocks) {
499 debugTrace(DEBUG_gc, "increasing size of nursery to %d blocks",
501 stp->blocks = allocNursery(stp, stp->blocks, blocks-nursery_blocks);
506 debugTrace(DEBUG_gc, "decreasing size of nursery to %d blocks",
510 while (nursery_blocks > blocks) {
512 next_bd->u.back = NULL;
513 nursery_blocks -= bd->blocks; // might be a large block
518 // might have gone just under, by freeing a large block, so make
519 // up the difference.
520 if (nursery_blocks < blocks) {
521 stp->blocks = allocNursery(stp, stp->blocks, blocks-nursery_blocks);
525 stp->n_blocks = blocks;
526 ASSERT(countBlocks(stp->blocks) == stp->n_blocks);
530 // Resize each of the nurseries to the specified size.
533 resizeNurseriesFixed (nat blocks)
536 for (i = 0; i < n_nurseries; i++) {
537 resizeNursery(&nurseries[i], blocks);
542 // Resize the nurseries to the total specified size.
545 resizeNurseries (nat blocks)
547 // If there are multiple nurseries, then we just divide the number
548 // of available blocks between them.
549 resizeNurseriesFixed(blocks / n_nurseries);
552 /* -----------------------------------------------------------------------------
553 The allocate() interface
555 allocate(n) always succeeds, and returns a chunk of memory n words
556 long. n can be larger than the size of a block if necessary, in
557 which case a contiguous block group will be allocated.
558 -------------------------------------------------------------------------- */
568 TICK_ALLOC_HEAP_NOCTR(n);
571 /* big allocation (>LARGE_OBJECT_THRESHOLD) */
572 /* ToDo: allocate directly into generation 1 */
573 if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
574 nat req_blocks = (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
575 bd = allocGroup(req_blocks);
576 dbl_link_onto(bd, &g0s0->large_objects);
577 g0s0->n_large_blocks += req_blocks;
580 bd->flags = BF_LARGE;
581 bd->free = bd->start + n;
582 alloc_blocks += req_blocks;
586 /* small allocation (<LARGE_OBJECT_THRESHOLD) */
587 } else if (small_alloc_list == NULL || alloc_Hp + n > alloc_HpLim) {
588 if (small_alloc_list) {
589 small_alloc_list->free = alloc_Hp;
592 bd->link = small_alloc_list;
593 small_alloc_list = bd;
597 alloc_Hp = bd->start;
598 alloc_HpLim = bd->start + BLOCK_SIZE_W;
609 allocated_bytes( void )
613 allocated = alloc_blocks * BLOCK_SIZE_W - (alloc_HpLim - alloc_Hp);
614 if (pinned_object_block != NULL) {
615 allocated -= (pinned_object_block->start + BLOCK_SIZE_W) -
616 pinned_object_block->free;
623 tidyAllocateLists (void)
625 if (small_alloc_list != NULL) {
626 ASSERT(alloc_Hp >= small_alloc_list->start &&
627 alloc_Hp <= small_alloc_list->start + BLOCK_SIZE);
628 small_alloc_list->free = alloc_Hp;
632 /* -----------------------------------------------------------------------------
635 This allocates memory in the current thread - it is intended for
636 use primarily from STG-land where we have a Capability. It is
637 better than allocate() because it doesn't require taking the
638 sm_mutex lock in the common case.
640 Memory is allocated directly from the nursery if possible (but not
641 from the current nursery block, so as not to interfere with
643 -------------------------------------------------------------------------- */
646 allocateLocal (Capability *cap, nat n)
651 TICK_ALLOC_HEAP_NOCTR(n);
654 /* big allocation (>LARGE_OBJECT_THRESHOLD) */
655 /* ToDo: allocate directly into generation 1 */
656 if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
657 nat req_blocks = (lnat)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
659 bd = allocGroup(req_blocks);
660 dbl_link_onto(bd, &g0s0->large_objects);
661 g0s0->n_large_blocks += req_blocks;
664 bd->flags = BF_LARGE;
665 bd->free = bd->start + n;
666 alloc_blocks += req_blocks;
670 /* small allocation (<LARGE_OBJECT_THRESHOLD) */
673 bd = cap->r.rCurrentAlloc;
674 if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) {
676 // The CurrentAlloc block is full, we need to find another
677 // one. First, we try taking the next block from the
679 bd = cap->r.rCurrentNursery->link;
681 if (bd == NULL || bd->free + n > bd->start + BLOCK_SIZE_W) {
682 // The nursery is empty, or the next block is already
683 // full: allocate a fresh block (we can't fail here).
686 cap->r.rNursery->n_blocks++;
689 bd->step = cap->r.rNursery;
692 // we have a block in the nursery: take it and put
693 // it at the *front* of the nursery list, and use it
694 // to allocate() from.
695 cap->r.rCurrentNursery->link = bd->link;
696 if (bd->link != NULL) {
697 bd->link->u.back = cap->r.rCurrentNursery;
700 dbl_link_onto(bd, &cap->r.rNursery->blocks);
701 cap->r.rCurrentAlloc = bd;
702 IF_DEBUG(sanity, checkNurserySanity(cap->r.rNursery));
710 /* ---------------------------------------------------------------------------
711 Allocate a fixed/pinned object.
713 We allocate small pinned objects into a single block, allocating a
714 new block when the current one overflows. The block is chained
715 onto the large_object_list of generation 0 step 0.
717 NOTE: The GC can't in general handle pinned objects. This
718 interface is only safe to use for ByteArrays, which have no
719 pointers and don't require scavenging. It works because the
720 block's descriptor has the BF_LARGE flag set, so the block is
721 treated as a large object and chained onto various lists, rather
722 than the individual objects being copied. However, when it comes
723 to scavenge the block, the GC will only scavenge the first object.
724 The reason is that the GC can't linearly scan a block of pinned
725 objects at the moment (doing so would require using the
726 mostly-copying techniques). But since we're restricting ourselves
727 to pinned ByteArrays, not scavenging is ok.
729 This function is called by newPinnedByteArray# which immediately
730 fills the allocated memory with a MutableByteArray#.
731 ------------------------------------------------------------------------- */
734 allocatePinned( nat n )
737 bdescr *bd = pinned_object_block;
739 // If the request is for a large object, then allocate()
740 // will give us a pinned object anyway.
741 if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
747 TICK_ALLOC_HEAP_NOCTR(n);
750 // we always return 8-byte aligned memory. bd->free must be
751 // 8-byte aligned to begin with, so we just round up n to
752 // the nearest multiple of 8 bytes.
753 if (sizeof(StgWord) == 4) {
757 // If we don't have a block of pinned objects yet, or the current
758 // one isn't large enough to hold the new object, allocate a new one.
759 if (bd == NULL || (bd->free + n) > (bd->start + BLOCK_SIZE_W)) {
760 pinned_object_block = bd = allocBlock();
761 dbl_link_onto(bd, &g0s0->large_objects);
764 bd->flags = BF_PINNED | BF_LARGE;
765 bd->free = bd->start;
775 /* -----------------------------------------------------------------------------
776 This is the write barrier for MUT_VARs, a.k.a. IORefs. A
777 MUT_VAR_CLEAN object is not on the mutable list; a MUT_VAR_DIRTY
778 is. When written to, a MUT_VAR_CLEAN turns into a MUT_VAR_DIRTY
779 and is put on the mutable list.
780 -------------------------------------------------------------------------- */
783 dirty_MUT_VAR(StgRegTable *reg, StgClosure *p)
785 Capability *cap = regTableToCapability(reg);
787 if (p->header.info == &stg_MUT_VAR_CLEAN_info) {
788 p->header.info = &stg_MUT_VAR_DIRTY_info;
789 bd = Bdescr((StgPtr)p);
790 if (bd->gen_no > 0) recordMutableCap(p,cap,bd->gen_no);
794 /* -----------------------------------------------------------------------------
795 Allocation functions for GMP.
797 These all use the allocate() interface - we can't have any garbage
798 collection going on during a gmp operation, so we use allocate()
799 which always succeeds. The gmp operations which might need to
800 allocate will ask the storage manager (via doYouWantToGC()) whether
801 a garbage collection is required, in case we get into a loop doing
802 only allocate() style allocation.
803 -------------------------------------------------------------------------- */
806 stgAllocForGMP (size_t size_in_bytes)
809 nat data_size_in_words, total_size_in_words;
811 /* round up to a whole number of words */
812 data_size_in_words = (size_in_bytes + sizeof(W_) + 1) / sizeof(W_);
813 total_size_in_words = sizeofW(StgArrWords) + data_size_in_words;
815 /* allocate and fill it in. */
816 #if defined(THREADED_RTS)
817 arr = (StgArrWords *)allocateLocal(myTask()->cap, total_size_in_words);
819 arr = (StgArrWords *)allocateLocal(&MainCapability, total_size_in_words);
821 SET_ARR_HDR(arr, &stg_ARR_WORDS_info, CCCS, data_size_in_words);
823 /* and return a ptr to the goods inside the array */
828 stgReallocForGMP (void *ptr, size_t old_size, size_t new_size)
830 void *new_stuff_ptr = stgAllocForGMP(new_size);
832 char *p = (char *) ptr;
833 char *q = (char *) new_stuff_ptr;
835 for (; i < old_size; i++, p++, q++) {
839 return(new_stuff_ptr);
843 stgDeallocForGMP (void *ptr STG_UNUSED,
844 size_t size STG_UNUSED)
846 /* easy for us: the garbage collector does the dealloc'n */
849 /* -----------------------------------------------------------------------------
851 * -------------------------------------------------------------------------- */
853 /* -----------------------------------------------------------------------------
856 * Approximate how much we've allocated: number of blocks in the
857 * nursery + blocks allocated via allocate() - unused nusery blocks.
858 * This leaves a little slop at the end of each block, and doesn't
859 * take into account large objects (ToDo).
860 * -------------------------------------------------------------------------- */
863 calcAllocated( void )
868 allocated = allocated_bytes();
869 allocated += countNurseryBlocks() * BLOCK_SIZE_W;
874 for (i = 0; i < n_nurseries; i++) {
876 for ( bd = capabilities[i].r.rCurrentNursery->link;
877 bd != NULL; bd = bd->link ) {
878 allocated -= BLOCK_SIZE_W;
880 cap = &capabilities[i];
881 if (cap->r.rCurrentNursery->free <
882 cap->r.rCurrentNursery->start + BLOCK_SIZE_W) {
883 allocated -= (cap->r.rCurrentNursery->start + BLOCK_SIZE_W)
884 - cap->r.rCurrentNursery->free;
888 bdescr *current_nursery = MainCapability.r.rCurrentNursery;
890 for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
891 allocated -= BLOCK_SIZE_W;
893 if (current_nursery->free < current_nursery->start + BLOCK_SIZE_W) {
894 allocated -= (current_nursery->start + BLOCK_SIZE_W)
895 - current_nursery->free;
900 total_allocated += allocated;
904 /* Approximate the amount of live data in the heap. To be called just
905 * after garbage collection (see GarbageCollect()).
914 if (RtsFlags.GcFlags.generations == 1) {
915 live = (g0s0->n_blocks - 1) * BLOCK_SIZE_W +
916 ((lnat)g0s0->hp_bd->free - (lnat)g0s0->hp_bd->start) / sizeof(W_);
920 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
921 for (s = 0; s < generations[g].n_steps; s++) {
922 /* approximate amount of live data (doesn't take into account slop
923 * at end of each block).
925 if (g == 0 && s == 0) {
928 stp = &generations[g].steps[s];
929 live += (stp->n_large_blocks + stp->n_blocks - 1) * BLOCK_SIZE_W;
930 if (stp->hp_bd != NULL) {
931 live += ((lnat)stp->hp_bd->free - (lnat)stp->hp_bd->start)
934 if (stp->scavd_hp != NULL) {
935 live -= (P_)(BLOCK_ROUND_UP(stp->scavd_hp)) - stp->scavd_hp;
942 /* Approximate the number of blocks that will be needed at the next
943 * garbage collection.
945 * Assume: all data currently live will remain live. Steps that will
946 * be collected next time will therefore need twice as many blocks
947 * since all the data will be copied.
956 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
957 for (s = 0; s < generations[g].n_steps; s++) {
958 if (g == 0 && s == 0) { continue; }
959 stp = &generations[g].steps[s];
960 if (generations[g].steps[0].n_blocks +
961 generations[g].steps[0].n_large_blocks
962 > generations[g].max_blocks
963 && stp->is_compacted == 0) {
964 needed += 2 * stp->n_blocks;
966 needed += stp->n_blocks;
973 /* ----------------------------------------------------------------------------
976 Executable memory must be managed separately from non-executable
977 memory. Most OSs these days require you to jump through hoops to
978 dynamically allocate executable memory, due to various security
981 Here we provide a small memory allocator for executable memory.
982 Memory is managed with a page granularity; we allocate linearly
983 in the page, and when the page is emptied (all objects on the page
984 are free) we free the page again, not forgetting to make it
986 ------------------------------------------------------------------------- */
988 static bdescr *exec_block;
990 void *allocateExec (nat bytes)
997 // round up to words.
998 n = (bytes + sizeof(W_) + 1) / sizeof(W_);
1000 if (n+1 > BLOCK_SIZE_W) {
1001 barf("allocateExec: can't handle large objects");
1004 if (exec_block == NULL ||
1005 exec_block->free + n + 1 > exec_block->start + BLOCK_SIZE_W) {
1007 lnat pagesize = getPageSize();
1008 bd = allocGroup(stg_max(1, pagesize / BLOCK_SIZE));
1009 debugTrace(DEBUG_gc, "allocate exec block %p", bd->start);
1011 bd->flags = BF_EXEC;
1012 bd->link = exec_block;
1013 if (exec_block != NULL) {
1014 exec_block->u.back = bd;
1017 setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsTrue);
1020 *(exec_block->free) = n; // store the size of this chunk
1021 exec_block->gen_no += n; // gen_no stores the number of words allocated
1022 ret = exec_block->free + 1;
1023 exec_block->free += n + 1;
1029 void freeExec (void *addr)
1031 StgPtr p = (StgPtr)addr - 1;
1032 bdescr *bd = Bdescr((StgPtr)p);
1034 if ((bd->flags & BF_EXEC) == 0) {
1035 barf("freeExec: not executable");
1038 if (*(StgPtr)p == 0) {
1039 barf("freeExec: already free?");
1044 bd->gen_no -= *(StgPtr)p;
1047 // Free the block if it is empty, but not if it is the block at
1048 // the head of the queue.
1049 if (bd->gen_no == 0 && bd != exec_block) {
1050 debugTrace(DEBUG_gc, "free exec block %p", bd->start);
1052 bd->u.back->link = bd->link;
1054 exec_block = bd->link;
1057 bd->link->u.back = bd->u.back;
1059 setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsFalse);
1066 /* -----------------------------------------------------------------------------
1069 memInventory() checks for memory leaks by counting up all the
1070 blocks we know about and comparing that to the number of blocks
1071 allegedly floating around in the system.
1072 -------------------------------------------------------------------------- */
1077 stepBlocks (step *stp)
1082 total_blocks = stp->n_blocks;
1083 total_blocks += stp->n_old_blocks;
1084 for (bd = stp->large_objects; bd; bd = bd->link) {
1085 total_blocks += bd->blocks;
1086 /* hack for megablock groups: they have an extra block or two in
1087 the second and subsequent megablocks where the block
1088 descriptors would normally go.
1090 if (bd->blocks > BLOCKS_PER_MBLOCK) {
1091 total_blocks -= (MBLOCK_SIZE / BLOCK_SIZE - BLOCKS_PER_MBLOCK)
1092 * (bd->blocks/(MBLOCK_SIZE/BLOCK_SIZE));
1095 return total_blocks;
1104 lnat total_blocks = 0, free_blocks = 0;
1106 /* count the blocks we current have */
1108 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1109 for (i = 0; i < n_capabilities; i++) {
1110 for (bd = capabilities[i].mut_lists[g]; bd != NULL; bd = bd->link) {
1111 total_blocks += bd->blocks;
1114 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
1115 total_blocks += bd->blocks;
1117 for (s = 0; s < generations[g].n_steps; s++) {
1118 if (g==0 && s==0) continue;
1119 stp = &generations[g].steps[s];
1120 total_blocks += stepBlocks(stp);
1124 for (i = 0; i < n_nurseries; i++) {
1125 total_blocks += stepBlocks(&nurseries[i]);
1128 // We put pinned object blocks in g0s0, so better count blocks there too.
1129 total_blocks += stepBlocks(g0s0);
1132 /* any blocks held by allocate() */
1133 for (bd = small_alloc_list; bd; bd = bd->link) {
1134 total_blocks += bd->blocks;
1138 if (RtsFlags.ProfFlags.doHeapProfile == HEAP_BY_RETAINER) {
1139 total_blocks += retainerStackBlocks();
1143 // count the blocks allocated by the arena allocator
1144 total_blocks += arenaBlocks();
1146 // count the blocks containing executable memory
1147 for (bd = exec_block; bd; bd = bd->link) {
1148 total_blocks += bd->blocks;
1151 /* count the blocks on the free list */
1152 free_blocks = countFreeList();
1154 if (total_blocks + free_blocks != mblocks_allocated *
1155 BLOCKS_PER_MBLOCK) {
1156 debugBelch("Blocks: %ld live + %ld free = %ld total (%ld around)\n",
1157 total_blocks, free_blocks, total_blocks + free_blocks,
1158 mblocks_allocated * BLOCKS_PER_MBLOCK);
1161 ASSERT(total_blocks + free_blocks == mblocks_allocated * BLOCKS_PER_MBLOCK);
1166 countBlocks(bdescr *bd)
1169 for (n=0; bd != NULL; bd=bd->link) {
1175 /* Full heap sanity check. */
1181 if (RtsFlags.GcFlags.generations == 1) {
1182 checkHeap(g0s0->blocks);
1183 checkChain(g0s0->large_objects);
1186 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1187 for (s = 0; s < generations[g].n_steps; s++) {
1188 if (g == 0 && s == 0) { continue; }
1189 ASSERT(countBlocks(generations[g].steps[s].blocks)
1190 == generations[g].steps[s].n_blocks);
1191 ASSERT(countBlocks(generations[g].steps[s].large_objects)
1192 == generations[g].steps[s].n_large_blocks);
1193 checkHeap(generations[g].steps[s].blocks);
1194 checkChain(generations[g].steps[s].large_objects);
1196 checkMutableList(generations[g].mut_list, g);
1201 for (s = 0; s < n_nurseries; s++) {
1202 ASSERT(countBlocks(nurseries[s].blocks)
1203 == nurseries[s].n_blocks);
1204 ASSERT(countBlocks(nurseries[s].large_objects)
1205 == nurseries[s].n_large_blocks);
1208 checkFreeListSanity();
1212 /* Nursery sanity check */
1214 checkNurserySanity( step *stp )
1220 for (bd = stp->blocks; bd != NULL; bd = bd->link) {
1221 ASSERT(bd->u.back == prev);
1223 blocks += bd->blocks;
1225 ASSERT(blocks == stp->n_blocks);
1228 // handy function for use in gdb, because Bdescr() is inlined.
1229 extern bdescr *_bdescr( StgPtr p );