1 /* -----------------------------------------------------------------------------
2 * $Id: GC.c,v 1.21 1999/01/27 16:41:14 simonm Exp $
4 * Two-space garbage collector
6 * ---------------------------------------------------------------------------*/
12 #include "StoragePriv.h"
15 #include "SchedAPI.h" /* for ReverCAFs prototype */
18 #include "BlockAlloc.h"
20 #include "DebugProf.h"
23 #include "StablePriv.h"
27 /* STATIC OBJECT LIST.
30 * We maintain a linked list of static objects that are still live.
31 * The requirements for this list are:
33 * - we need to scan the list while adding to it, in order to
34 * scavenge all the static objects (in the same way that
35 * breadth-first scavenging works for dynamic objects).
37 * - we need to be able to tell whether an object is already on
38 * the list, to break loops.
40 * Each static object has a "static link field", which we use for
41 * linking objects on to the list. We use a stack-type list, consing
42 * objects on the front as they are added (this means that the
43 * scavenge phase is depth-first, not breadth-first, but that
46 * A separate list is kept for objects that have been scavenged
47 * already - this is so that we can zero all the marks afterwards.
49 * An object is on the list if its static link field is non-zero; this
50 * means that we have to mark the end of the list with '1', not NULL.
52 * Extra notes for generational GC:
54 * Each generation has a static object list associated with it. When
55 * collecting generations up to N, we treat the static object lists
56 * from generations > N as roots.
58 * We build up a static object list while collecting generations 0..N,
59 * which is then appended to the static object list of generation N+1.
61 StgClosure* static_objects; /* live static objects */
62 StgClosure* scavenged_static_objects; /* static objects scavenged so far */
64 /* N is the oldest generation being collected, where the generations
65 * are numbered starting at 0. A major GC (indicated by the major_gc
66 * flag) is when we're collecting all generations. We only attempt to
67 * deal with static objects and GC CAFs when doing a major GC.
70 static rtsBool major_gc;
72 /* Youngest generation that objects should be evacuated to in
73 * evacuate(). (Logically an argument to evacuate, but it's static
74 * a lot of the time so we optimise it into a global variable).
80 static StgWeak *old_weak_ptr_list; /* also pending finaliser list */
81 static rtsBool weak_done; /* all done for this pass */
83 /* Flag indicating failure to evacuate an object to the desired
86 static rtsBool failed_to_evac;
88 /* Old to-space (used for two-space collector only)
92 /* -----------------------------------------------------------------------------
93 Static function declarations
94 -------------------------------------------------------------------------- */
96 static StgClosure *evacuate(StgClosure *q);
97 static void zeroStaticObjectList(StgClosure* first_static);
98 static rtsBool traverse_weak_ptr_list(void);
99 static void zeroMutableList(StgMutClosure *first);
100 static void revertDeadCAFs(void);
102 static void scavenge_stack(StgPtr p, StgPtr stack_end);
103 static void scavenge_large(step *step);
104 static void scavenge(step *step);
105 static void scavenge_static(void);
106 static StgMutClosure *scavenge_mutable_list(StgMutClosure *p, nat gen);
109 static void gcCAFs(void);
112 /* -----------------------------------------------------------------------------
115 For garbage collecting generation N (and all younger generations):
117 - follow all pointers in the root set. the root set includes all
118 mutable objects in all steps in all generations.
120 - for each pointer, evacuate the object it points to into either
121 + to-space in the next higher step in that generation, if one exists,
122 + if the object's generation == N, then evacuate it to the next
123 generation if one exists, or else to-space in the current
125 + if the object's generation < N, then evacuate it to to-space
126 in the next generation.
128 - repeatedly scavenge to-space from each step in each generation
129 being collected until no more objects can be evacuated.
131 - free from-space in each step, and set from-space = to-space.
133 -------------------------------------------------------------------------- */
135 void GarbageCollect(void (*get_roots)(void))
139 lnat live, allocated, collected = 0;
143 CostCentreStack *prev_CCS;
146 /* tell the stats department that we've started a GC */
149 /* attribute any costs to CCS_GC */
155 /* We might have been called from Haskell land by _ccall_GC, in
156 * which case we need to call threadPaused() because the scheduler
157 * won't have done it.
159 if (CurrentTSO) { threadPaused(CurrentTSO); }
161 /* Approximate how much we allocated: number of blocks in the
162 * nursery + blocks allocated via allocate() - unused nusery blocks.
163 * This leaves a little slop at the end of each block, and doesn't
164 * take into account large objects (ToDo).
166 allocated = (nursery_blocks * BLOCK_SIZE_W) + allocated_bytes();
167 for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
168 allocated -= BLOCK_SIZE_W;
171 /* Figure out which generation to collect
174 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
175 if (generations[g].steps[0].n_blocks >= generations[g].max_blocks) {
179 major_gc = (N == RtsFlags.GcFlags.generations-1);
181 /* check stack sanity *before* GC (ToDo: check all threads) */
182 /*IF_DEBUG(sanity, checkTSO(MainTSO,0)); */
183 IF_DEBUG(sanity, checkFreeListSanity());
185 /* Initialise the static object lists
187 static_objects = END_OF_STATIC_LIST;
188 scavenged_static_objects = END_OF_STATIC_LIST;
190 /* zero the mutable list for the oldest generation (see comment by
191 * zeroMutableList below).
194 zeroMutableList(generations[RtsFlags.GcFlags.generations-1].mut_list);
197 /* Save the old to-space if we're doing a two-space collection
199 if (RtsFlags.GcFlags.generations == 1) {
200 old_to_space = g0s0->to_space;
201 g0s0->to_space = NULL;
204 /* Initialise to-space in all the generations/steps that we're
207 for (g = 0; g <= N; g++) {
208 generations[g].mut_list = END_MUT_LIST;
210 for (s = 0; s < generations[g].n_steps; s++) {
212 /* generation 0, step 0 doesn't need to-space */
213 if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) {
217 /* Get a free block for to-space. Extra blocks will be chained on
221 step = &generations[g].steps[s];
222 ASSERT(step->gen->no == g);
223 ASSERT(step->hp ? Bdescr(step->hp)->step == step : rtsTrue);
224 bd->gen = &generations[g];
227 bd->evacuated = 1; /* it's a to-space block */
228 step->hp = bd->start;
229 step->hpLim = step->hp + BLOCK_SIZE_W;
232 step->to_blocks = 1; /* ???? */
233 step->scan = bd->start;
235 step->new_large_objects = NULL;
236 step->scavenged_large_objects = NULL;
237 /* mark the large objects as not evacuated yet */
238 for (bd = step->large_objects; bd; bd = bd->link) {
244 /* make sure the older generations have at least one block to
245 * allocate into (this makes things easier for copy(), see below.
247 for (g = N+1; g < RtsFlags.GcFlags.generations; g++) {
248 for (s = 0; s < generations[g].n_steps; s++) {
249 step = &generations[g].steps[s];
250 if (step->hp_bd == NULL) {
252 bd->gen = &generations[g];
255 bd->evacuated = 0; /* *not* a to-space block */
256 step->hp = bd->start;
257 step->hpLim = step->hp + BLOCK_SIZE_W;
262 /* Set the scan pointer for older generations: remember we
263 * still have to scavenge objects that have been promoted. */
264 step->scan = step->hp;
265 step->scan_bd = step->hp_bd;
266 step->to_space = NULL;
268 step->new_large_objects = NULL;
269 step->scavenged_large_objects = NULL;
273 /* -----------------------------------------------------------------------
274 * follow all the roots that we know about:
275 * - mutable lists from each generation > N
276 * we want to *scavenge* these roots, not evacuate them: they're not
277 * going to move in this GC.
278 * Also: do them in reverse generation order. This is because we
279 * often want to promote objects that are pointed to by older
280 * generations early, so we don't have to repeatedly copy them.
281 * Doing the generations in reverse order ensures that we don't end
282 * up in the situation where we want to evac an object to gen 3 and
283 * it has already been evaced to gen 2.
286 StgMutClosure *tmp, **pp;
287 for (g = N+1; g < RtsFlags.GcFlags.generations; g++) {
288 generations[g].saved_mut_list = generations[g].mut_list;
289 generations[g].mut_list = END_MUT_LIST;
292 for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
293 tmp = scavenge_mutable_list(generations[g].saved_mut_list, g);
294 pp = &generations[g].mut_list;
295 while (*pp != END_MUT_LIST) {
296 pp = &(*pp)->mut_link;
302 /* follow all the roots that the application knows about.
307 /* And don't forget to mark the TSO if we got here direct from
310 CurrentTSO = (StgTSO *)MarkRoot((StgClosure *)CurrentTSO);
313 /* Mark the weak pointer list, and prepare to detect dead weak
317 old_weak_ptr_list = weak_ptr_list;
318 weak_ptr_list = NULL;
319 weak_done = rtsFalse;
321 /* Mark the stable pointer table.
323 markStablePtrTable(major_gc);
327 /* ToDo: To fix the caf leak, we need to make the commented out
328 * parts of this code do something sensible - as described in
331 extern void markHugsObjects(void);
333 /* ToDo: This (undefined) function should contain the scavenge
334 * loop immediately below this block of code - but I'm not sure
335 * enough of the details to do this myself.
337 scavengeEverything();
338 /* revert dead CAFs and update enteredCAFs list */
343 /* This will keep the CAFs and the attached BCOs alive
344 * but the values will have been reverted
346 scavengeEverything();
351 /* -------------------------------------------------------------------------
352 * Repeatedly scavenge all the areas we know about until there's no
353 * more scavenging to be done.
360 /* scavenge static objects */
361 if (major_gc && static_objects != END_OF_STATIC_LIST) {
365 /* When scavenging the older generations: Objects may have been
366 * evacuated from generations <= N into older generations, and we
367 * need to scavenge these objects. We're going to try to ensure that
368 * any evacuations that occur move the objects into at least the
369 * same generation as the object being scavenged, otherwise we
370 * have to create new entries on the mutable list for the older
374 /* scavenge each step in generations 0..maxgen */
377 for (gen = RtsFlags.GcFlags.generations-1; gen >= 0; gen--) {
378 for (s = 0; s < generations[gen].n_steps; s++) {
379 step = &generations[gen].steps[s];
381 if (step->hp_bd != step->scan_bd || step->scan < step->hp) {
385 if (step->new_large_objects != NULL) {
386 scavenge_large(step);
392 if (flag) { goto loop; }
394 /* must be last... */
395 if (traverse_weak_ptr_list()) { /* returns rtsTrue if evaced something */
400 /* Now see which stable names are still alive
402 gcStablePtrTable(major_gc);
404 /* Set the maximum blocks for the oldest generation, based on twice
405 * the amount of live data now, adjusted to fit the maximum heap
408 * This is an approximation, since in the worst case we'll need
409 * twice the amount of live data plus whatever space the other
412 if (RtsFlags.GcFlags.generations > 1) {
414 oldest_gen->max_blocks =
415 stg_max(oldest_gen->steps[0].to_blocks * RtsFlags.GcFlags.oldGenFactor,
416 RtsFlags.GcFlags.minOldGenSize);
417 if (oldest_gen->max_blocks > RtsFlags.GcFlags.maxHeapSize / 2) {
418 oldest_gen->max_blocks = RtsFlags.GcFlags.maxHeapSize / 2;
419 if (((int)oldest_gen->max_blocks -
420 (int)oldest_gen->steps[0].to_blocks) <
421 (RtsFlags.GcFlags.pcFreeHeap *
422 RtsFlags.GcFlags.maxHeapSize / 200)) {
429 /* run through all the generations/steps and tidy up
431 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
434 generations[g].collections++; /* for stats */
437 for (s = 0; s < generations[g].n_steps; s++) {
439 step = &generations[g].steps[s];
441 if (!(g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1)) {
442 /* Tidy the end of the to-space chains */
443 step->hp_bd->free = step->hp;
444 step->hp_bd->link = NULL;
447 /* for generations we collected... */
450 collected += step->n_blocks * BLOCK_SIZE_W; /* for stats */
452 /* free old memory and shift to-space into from-space for all
453 * the collected steps (except the allocation area). These
454 * freed blocks will probaby be quickly recycled.
456 if (!(g == 0 && s == 0)) {
457 freeChain(step->blocks);
458 step->blocks = step->to_space;
459 step->n_blocks = step->to_blocks;
460 step->to_space = NULL;
462 for (bd = step->blocks; bd != NULL; bd = bd->link) {
463 bd->evacuated = 0; /* now from-space */
467 /* LARGE OBJECTS. The current live large objects are chained on
468 * scavenged_large, having been moved during garbage
469 * collection from large_objects. Any objects left on
470 * large_objects list are therefore dead, so we free them here.
472 for (bd = step->large_objects; bd != NULL; bd = next) {
477 for (bd = step->scavenged_large_objects; bd != NULL; bd = bd->link) {
480 step->large_objects = step->scavenged_large_objects;
482 /* Set the maximum blocks for this generation, interpolating
483 * between the maximum size of the oldest and youngest
486 * max_blocks = oldgen_max_blocks * G
487 * ----------------------
491 generations[g].max_blocks = (oldest_gen->max_blocks * g)
492 / (RtsFlags.GcFlags.generations-1);
495 /* for older generations... */
498 /* For older generations, we need to append the
499 * scavenged_large_object list (i.e. large objects that have been
500 * promoted during this GC) to the large_object list for that step.
502 for (bd = step->scavenged_large_objects; bd; bd = next) {
505 dbl_link_onto(bd, &step->large_objects);
508 /* add the new blocks we promoted during this GC */
509 step->n_blocks += step->to_blocks;
514 /* Two-space collector:
515 * Free the old to-space, and estimate the amount of live data.
517 if (RtsFlags.GcFlags.generations == 1) {
520 if (old_to_space != NULL) {
521 freeChain(old_to_space);
523 for (bd = g0s0->to_space; bd != NULL; bd = bd->link) {
524 bd->evacuated = 0; /* now from-space */
526 live = g0s0->to_blocks * BLOCK_SIZE_W +
527 ((lnat)g0s0->hp_bd->free - (lnat)g0s0->hp_bd->start) / sizeof(W_);
529 /* For a two-space collector, we need to resize the nursery. */
531 /* set up a new nursery. Allocate a nursery size based on a
532 * function of the amount of live data (currently a factor of 2,
533 * should be configurable (ToDo)). Use the blocks from the old
534 * nursery if possible, freeing up any left over blocks.
536 * If we get near the maximum heap size, then adjust our nursery
537 * size accordingly. If the nursery is the same size as the live
538 * data (L), then we need 3L bytes. We can reduce the size of the
539 * nursery to bring the required memory down near 2L bytes.
541 * A normal 2-space collector would need 4L bytes to give the same
542 * performance we get from 3L bytes, reducing to the same
543 * performance at 2L bytes.
545 blocks = g0s0->n_blocks;
547 if ( blocks * RtsFlags.GcFlags.oldGenFactor * 2 >
548 RtsFlags.GcFlags.maxHeapSize ) {
549 int adjusted_blocks; /* signed on purpose */
552 adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);
553 IF_DEBUG(gc, fprintf(stderr, "Near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %d\n", RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks));
554 pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize;
555 if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even be < 0 */ {
558 blocks = adjusted_blocks;
561 blocks *= RtsFlags.GcFlags.oldGenFactor;
562 if (blocks < RtsFlags.GcFlags.minAllocAreaSize) {
563 blocks = RtsFlags.GcFlags.minAllocAreaSize;
567 if (nursery_blocks < blocks) {
568 IF_DEBUG(gc, fprintf(stderr, "Increasing size of nursery to %d blocks\n",
570 g0s0->blocks = allocNursery(g0s0->blocks, blocks-nursery_blocks);
574 IF_DEBUG(gc, fprintf(stderr, "Decreasing size of nursery to %d blocks\n",
576 for (bd = g0s0->blocks; nursery_blocks > blocks; nursery_blocks--) {
584 g0s0->n_blocks = nursery_blocks = blocks;
587 /* Generational collector:
588 * estimate the amount of live data, and adjust the allocation
589 * area size if the user has given us a suggestion (+RTS -H<blah>)
593 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
594 for (s = 0; s < generations[g].n_steps; s++) {
595 /* approximate amount of live data (doesn't take into account slop
596 * at end of each block). ToDo: this more accurately.
598 if (g == 0 && s == 0) { continue; }
599 step = &generations[g].steps[s];
600 live += step->n_blocks * BLOCK_SIZE_W +
601 ((lnat)step->hp_bd->free -(lnat)step->hp_bd->start) / sizeof(W_);
605 if (RtsFlags.GcFlags.heapSizeSuggestion) {
607 (RtsFlags.GcFlags.heapSizeSuggestion - live / BLOCK_SIZE_W) / 2;
610 if (avail_blocks > RtsFlags.GcFlags.minAllocAreaSize) {
611 blocks = avail_blocks;
613 blocks = RtsFlags.GcFlags.minAllocAreaSize;
616 if (blocks > g0s0->n_blocks) {
617 /* need to add some blocks on */
618 fprintf(stderr, "Increasing size of alloc area to %d blocks\n", blocks);
619 g0s0->blocks = allocNursery(g0s0->blocks, avail_blocks - g0s0->n_blocks);
622 fprintf(stderr, "Decreasing size of alloc area to %d blocks\n", blocks);
623 for (bd = g0s0->blocks; nursery_blocks > blocks; nursery_blocks--) {
630 g0s0->n_blocks = nursery_blocks = blocks;
634 /* revert dead CAFs and update enteredCAFs list */
637 /* mark the garbage collected CAFs as dead */
639 if (major_gc) { gcCAFs(); }
642 /* zero the scavenged static object list */
644 zeroStaticObjectList(scavenged_static_objects);
649 for (bd = g0s0->blocks; bd; bd = bd->link) {
650 bd->free = bd->start;
651 ASSERT(bd->gen == g0);
652 ASSERT(bd->step == g0s0);
654 current_nursery = g0s0->blocks;
656 /* Free the small objects allocated via allocate(), since this will
657 * all have been copied into G0S1 now.
659 if (small_alloc_list != NULL) {
660 freeChain(small_alloc_list);
662 small_alloc_list = NULL;
664 alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
666 /* start any pending finalisers */
667 scheduleFinalisers(old_weak_ptr_list);
669 /* check sanity after GC */
671 if (RtsFlags.GcFlags.generations == 1) {
672 IF_DEBUG(sanity, checkHeap(g0s0->to_space, NULL));
673 IF_DEBUG(sanity, checkChain(g0s0->large_objects));
676 for (g = 0; g <= N; g++) {
677 for (s = 0; s < generations[g].n_steps; s++) {
678 if (g == 0 && s == 0) { continue; }
679 IF_DEBUG(sanity, checkHeap(generations[g].steps[s].blocks, NULL));
682 for (g = N+1; g < RtsFlags.GcFlags.generations; g++) {
683 for (s = 0; s < generations[g].n_steps; s++) {
684 IF_DEBUG(sanity, checkHeap(generations[g].steps[s].blocks,
685 generations[g].steps[s].blocks->start));
686 IF_DEBUG(sanity, checkChain(generations[g].steps[s].large_objects));
689 IF_DEBUG(sanity, checkFreeListSanity());
693 IF_DEBUG(gc, stat_describe_gens());
696 /* symbol-table based profiling */
697 /* heapCensus(to_space); */ /* ToDo */
700 /* restore enclosing cost centre */
705 /* check for memory leaks if sanity checking is on */
706 IF_DEBUG(sanity, memInventory());
708 /* ok, GC over: tell the stats department what happened. */
709 stat_endGC(allocated, collected, live, N);
712 /* -----------------------------------------------------------------------------
715 traverse_weak_ptr_list is called possibly many times during garbage
716 collection. It returns a flag indicating whether it did any work
717 (i.e. called evacuate on any live pointers).
719 Invariant: traverse_weak_ptr_list is called when the heap is in an
720 idempotent state. That means that there are no pending
721 evacuate/scavenge operations. This invariant helps the weak
722 pointer code decide which weak pointers are dead - if there are no
723 new live weak pointers, then all the currently unreachable ones are
726 For generational GC: we just don't try to finalise weak pointers in
727 older generations than the one we're collecting. This could
728 probably be optimised by keeping per-generation lists of weak
729 pointers, but for a few weak pointers this scheme will work.
730 -------------------------------------------------------------------------- */
733 traverse_weak_ptr_list(void)
735 StgWeak *w, **last_w, *next_w;
737 rtsBool flag = rtsFalse;
739 if (weak_done) { return rtsFalse; }
741 /* doesn't matter where we evacuate values/finalisers to, since
742 * these pointers are treated as roots (iff the keys are alive).
746 last_w = &old_weak_ptr_list;
747 for (w = old_weak_ptr_list; w; w = next_w) {
749 if ((new = isAlive(w->key))) {
751 /* evacuate the value and finaliser */
752 w->value = evacuate(w->value);
753 w->finaliser = evacuate(w->finaliser);
754 /* remove this weak ptr from the old_weak_ptr list */
756 /* and put it on the new weak ptr list */
758 w->link = weak_ptr_list;
761 IF_DEBUG(weak, fprintf(stderr,"Weak pointer still alive at %p -> %p\n", w, w->key));
771 /* If we didn't make any changes, then we can go round and kill all
772 * the dead weak pointers. The old_weak_ptr list is used as a list
773 * of pending finalisers later on.
775 if (flag == rtsFalse) {
776 for (w = old_weak_ptr_list; w; w = w->link) {
777 w->value = evacuate(w->value);
778 w->finaliser = evacuate(w->finaliser);
786 /* -----------------------------------------------------------------------------
787 isAlive determines whether the given closure is still alive (after
788 a garbage collection) or not. It returns the new address of the
789 closure if it is alive, or NULL otherwise.
790 -------------------------------------------------------------------------- */
793 isAlive(StgClosure *p)
801 /* ToDo: for static closures, check the static link field.
802 * Problem here is that we sometimes don't set the link field, eg.
803 * for static closures with an empty SRT or CONSTR_STATIC_NOCAFs.
806 /* ignore closures in generations that we're not collecting. */
807 if (LOOKS_LIKE_STATIC(p) || Bdescr((P_)p)->gen->no > N) {
811 switch (info->type) {
816 case IND_OLDGEN: /* rely on compatible layout with StgInd */
817 case IND_OLDGEN_PERM:
818 /* follow indirections */
819 p = ((StgInd *)p)->indirectee;
824 return ((StgEvacuated *)p)->evacuee;
834 MarkRoot(StgClosure *root)
836 return evacuate(root);
839 static void addBlock(step *step)
841 bdescr *bd = allocBlock();
845 if (step->gen->no <= N) {
851 step->hp_bd->free = step->hp;
852 step->hp_bd->link = bd;
853 step->hp = bd->start;
854 step->hpLim = step->hp + BLOCK_SIZE_W;
859 static __inline__ StgClosure *
860 copy(StgClosure *src, nat size, step *step)
864 /* Find out where we're going, using the handy "to" pointer in
865 * the step of the source object. If it turns out we need to
866 * evacuate to an older generation, adjust it here (see comment
869 if (step->gen->no < evac_gen) {
870 step = &generations[evac_gen].steps[0];
873 /* chain a new block onto the to-space for the destination step if
876 if (step->hp + size >= step->hpLim) {
880 for(to = step->hp, from = (P_)src; size>0; --size) {
886 return (StgClosure *)dest;
889 /* Special version of copy() for when we only want to copy the info
890 * pointer of an object, but reserve some padding after it. This is
891 * used to optimise evacuation of BLACKHOLEs.
894 static __inline__ StgClosure *
895 copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *step)
899 if (step->gen->no < evac_gen) {
900 step = &generations[evac_gen].steps[0];
903 if (step->hp + size_to_reserve >= step->hpLim) {
907 for(to = step->hp, from = (P_)src; size_to_copy>0; --size_to_copy) {
912 step->hp += size_to_reserve;
913 return (StgClosure *)dest;
916 static __inline__ void
917 upd_evacuee(StgClosure *p, StgClosure *dest)
919 StgEvacuated *q = (StgEvacuated *)p;
921 SET_INFO(q,&EVACUATED_info);
925 /* -----------------------------------------------------------------------------
926 Evacuate a mutable object
928 If we evacuate a mutable object to an old generation, cons the
929 object onto the older generation's mutable list.
930 -------------------------------------------------------------------------- */
933 evacuate_mutable(StgMutClosure *c)
938 if (bd->gen->no > 0) {
939 c->mut_link = bd->gen->mut_list;
940 bd->gen->mut_list = c;
944 /* -----------------------------------------------------------------------------
945 Evacuate a large object
947 This just consists of removing the object from the (doubly-linked)
948 large_alloc_list, and linking it on to the (singly-linked)
949 new_large_objects list, from where it will be scavenged later.
951 Convention: bd->evacuated is /= 0 for a large object that has been
952 evacuated, or 0 otherwise.
953 -------------------------------------------------------------------------- */
956 evacuate_large(StgPtr p, rtsBool mutable)
958 bdescr *bd = Bdescr(p);
961 /* should point to the beginning of the block */
962 ASSERT(((W_)p & BLOCK_MASK) == 0);
964 /* already evacuated? */
966 /* Don't forget to set the failed_to_evac flag if we didn't get
967 * the desired destination (see comments in evacuate()).
969 if (bd->gen->no < evac_gen) {
970 failed_to_evac = rtsTrue;
971 TICK_GC_FAILED_PROMOTION();
977 /* remove from large_object list */
979 bd->back->link = bd->link;
980 } else { /* first object in the list */
981 step->large_objects = bd->link;
984 bd->link->back = bd->back;
987 /* link it on to the evacuated large object list of the destination step
990 if (step->gen->no < evac_gen) {
991 step = &generations[evac_gen].steps[0];
996 bd->link = step->new_large_objects;
997 step->new_large_objects = bd;
1001 evacuate_mutable((StgMutClosure *)p);
1005 /* -----------------------------------------------------------------------------
1006 Adding a MUT_CONS to an older generation.
1008 This is necessary from time to time when we end up with an
1009 old-to-new generation pointer in a non-mutable object. We defer
1010 the promotion until the next GC.
1011 -------------------------------------------------------------------------- */
1014 mkMutCons(StgClosure *ptr, generation *gen)
1019 step = &gen->steps[0];
1021 /* chain a new block onto the to-space for the destination step if
1024 if (step->hp + sizeofW(StgIndOldGen) >= step->hpLim) {
1028 q = (StgMutVar *)step->hp;
1029 step->hp += sizeofW(StgMutVar);
1031 SET_HDR(q,&MUT_CONS_info,CCS_GC);
1033 evacuate_mutable((StgMutClosure *)q);
1035 return (StgClosure *)q;
1038 /* -----------------------------------------------------------------------------
1041 This is called (eventually) for every live object in the system.
1043 The caller to evacuate specifies a desired generation in the
1044 evac_gen global variable. The following conditions apply to
1045 evacuating an object which resides in generation M when we're
1046 collecting up to generation N
1050 else evac to step->to
1052 if M < evac_gen evac to evac_gen, step 0
1054 if the object is already evacuated, then we check which generation
1057 if M >= evac_gen do nothing
1058 if M < evac_gen set failed_to_evac flag to indicate that we
1059 didn't manage to evacuate this object into evac_gen.
1061 -------------------------------------------------------------------------- */
1065 evacuate(StgClosure *q)
1070 const StgInfoTable *info;
1073 if (!LOOKS_LIKE_STATIC(q)) {
1075 if (bd->gen->no > N) {
1076 /* Can't evacuate this object, because it's in a generation
1077 * older than the ones we're collecting. Let's hope that it's
1078 * in evac_gen or older, or we will have to make an IND_OLDGEN object.
1080 if (bd->gen->no < evac_gen) {
1082 failed_to_evac = rtsTrue;
1083 TICK_GC_FAILED_PROMOTION();
1087 step = bd->step->to;
1090 /* make sure the info pointer is into text space */
1091 ASSERT(q && (LOOKS_LIKE_GHC_INFO(GET_INFO(q))
1092 || IS_HUGS_CONSTR_INFO(GET_INFO(q))));
1095 switch (info -> type) {
1098 to = copy(q,bco_sizeW(stgCast(StgBCO*,q)),step);
1104 to = copy(q,sizeW_fromITBL(info),step);
1106 evacuate_mutable((StgMutClosure *)to);
1110 stable_ptr_table[((StgStableName *)q)->sn].keep = rtsTrue;
1111 to = copy(q,sizeofW(StgStableName),step);
1119 to = copy(q,sizeofW(StgHeader)+1,step);
1123 case THUNK_1_0: /* here because of MIN_UPD_SIZE */
1134 to = copy(q,sizeofW(StgHeader)+2,step);
1142 case IND_OLDGEN_PERM:
1147 to = copy(q,sizeW_fromITBL(info),step);
1153 to = copyPart(q,BLACKHOLE_sizeW(),sizeofW(StgHeader),step);
1158 to = copy(q,BLACKHOLE_sizeW(),step);
1160 evacuate_mutable((StgMutClosure *)to);
1163 case THUNK_SELECTOR:
1165 const StgInfoTable* selectee_info;
1166 StgClosure* selectee = ((StgSelector*)q)->selectee;
1169 selectee_info = get_itbl(selectee);
1170 switch (selectee_info->type) {
1179 StgNat32 offset = info->layout.selector_offset;
1181 /* check that the size is in range */
1183 (StgNat32)(selectee_info->layout.payload.ptrs +
1184 selectee_info->layout.payload.nptrs));
1186 /* perform the selection! */
1187 q = selectee->payload[offset];
1189 /* if we're already in to-space, there's no need to continue
1190 * with the evacuation, just update the source address with
1191 * a pointer to the (evacuated) constructor field.
1193 if (IS_USER_PTR(q)) {
1194 bdescr *bd = Bdescr((P_)q);
1195 if (bd->evacuated) {
1196 if (bd->gen->no < evac_gen) {
1197 failed_to_evac = rtsTrue;
1198 TICK_GC_FAILED_PROMOTION();
1204 /* otherwise, carry on and evacuate this constructor field,
1205 * (but not the constructor itself)
1214 case IND_OLDGEN_PERM:
1215 selectee = stgCast(StgInd *,selectee)->indirectee;
1219 selectee = stgCast(StgCAF *,selectee)->value;
1223 selectee = stgCast(StgEvacuated*,selectee)->evacuee;
1233 case THUNK_SELECTOR:
1234 /* aargh - do recursively???? */
1239 /* not evaluated yet */
1243 barf("evacuate: THUNK_SELECTOR: strange selectee");
1246 to = copy(q,THUNK_SELECTOR_sizeW(),step);
1252 /* follow chains of indirections, don't evacuate them */
1253 q = ((StgInd*)q)->indirectee;
1256 /* ToDo: optimise STATIC_LINK for known cases.
1257 - FUN_STATIC : payload[0]
1258 - THUNK_STATIC : payload[1]
1259 - IND_STATIC : payload[1]
1263 if (info->srt_len == 0) { /* small optimisation */
1269 /* don't want to evacuate these, but we do want to follow pointers
1270 * from SRTs - see scavenge_static.
1273 /* put the object on the static list, if necessary.
1275 if (major_gc && STATIC_LINK(info,(StgClosure *)q) == NULL) {
1276 STATIC_LINK(info,(StgClosure *)q) = static_objects;
1277 static_objects = (StgClosure *)q;
1281 case CONSTR_INTLIKE:
1282 case CONSTR_CHARLIKE:
1283 case CONSTR_NOCAF_STATIC:
1284 /* no need to put these on the static linked list, they don't need
1299 /* shouldn't see these */
1300 barf("evacuate: stack frame\n");
1304 /* these are special - the payload is a copy of a chunk of stack,
1306 to = copy(q,pap_sizeW(stgCast(StgPAP*,q)),step);
1311 /* Already evacuated, just return the forwarding address.
1312 * HOWEVER: if the requested destination generation (evac_gen) is
1313 * older than the actual generation (because the object was
1314 * already evacuated to a younger generation) then we have to
1315 * set the failed_to_evac flag to indicate that we couldn't
1316 * manage to promote the object to the desired generation.
1318 if (evac_gen > 0) { /* optimisation */
1319 StgClosure *p = ((StgEvacuated*)q)->evacuee;
1320 if (Bdescr((P_)p)->gen->no < evac_gen) {
1321 /* fprintf(stderr,"evac failed!\n");*/
1322 failed_to_evac = rtsTrue;
1323 TICK_GC_FAILED_PROMOTION();
1326 return ((StgEvacuated*)q)->evacuee;
1331 nat size = arr_words_sizeW(stgCast(StgArrWords*,q));
1333 if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
1334 evacuate_large((P_)q, rtsFalse);
1337 /* just copy the block */
1338 to = copy(q,size,step);
1345 case MUT_ARR_PTRS_FROZEN:
1347 nat size = mut_arr_ptrs_sizeW(stgCast(StgMutArrPtrs*,q));
1349 if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
1350 evacuate_large((P_)q, info->type == MUT_ARR_PTRS);
1353 /* just copy the block */
1354 to = copy(q,size,step);
1356 if (info->type == MUT_ARR_PTRS) {
1357 evacuate_mutable((StgMutClosure *)to);
1365 StgTSO *tso = stgCast(StgTSO *,q);
1366 nat size = tso_sizeW(tso);
1369 /* Large TSOs don't get moved, so no relocation is required.
1371 if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
1372 evacuate_large((P_)q, rtsTrue);
1375 /* To evacuate a small TSO, we need to relocate the update frame
1379 StgTSO *new_tso = (StgTSO *)copy((StgClosure *)tso,tso_sizeW(tso),step);
1381 diff = (StgPtr)new_tso - (StgPtr)tso; /* In *words* */
1383 /* relocate the stack pointers... */
1384 new_tso->su = (StgUpdateFrame *) ((StgPtr)new_tso->su + diff);
1385 new_tso->sp = (StgPtr)new_tso->sp + diff;
1386 new_tso->splim = (StgPtr)new_tso->splim + diff;
1388 relocate_TSO(tso, new_tso);
1389 upd_evacuee(q,(StgClosure *)new_tso);
1391 evacuate_mutable((StgMutClosure *)new_tso);
1392 return (StgClosure *)new_tso;
1398 fprintf(stderr,"evacuate: unimplemented/strange closure type\n");
1402 barf("evacuate: strange closure type");
1408 /* -----------------------------------------------------------------------------
1409 relocate_TSO is called just after a TSO has been copied from src to
1410 dest. It adjusts the update frame list for the new location.
1411 -------------------------------------------------------------------------- */
1414 relocate_TSO(StgTSO *src, StgTSO *dest)
1421 diff = (StgPtr)dest->sp - (StgPtr)src->sp; /* In *words* */
1425 while ((P_)su < dest->stack + dest->stack_size) {
1426 switch (get_itbl(su)->type) {
1428 /* GCC actually manages to common up these three cases! */
1431 su->link = (StgUpdateFrame *) ((StgPtr)su->link + diff);
1436 cf = (StgCatchFrame *)su;
1437 cf->link = (StgUpdateFrame *) ((StgPtr)cf->link + diff);
1442 sf = (StgSeqFrame *)su;
1443 sf->link = (StgUpdateFrame *) ((StgPtr)sf->link + diff);
1452 barf("relocate_TSO");
1461 scavenge_srt(const StgInfoTable *info)
1463 StgClosure **srt, **srt_end;
1465 /* evacuate the SRT. If srt_len is zero, then there isn't an
1466 * srt field in the info table. That's ok, because we'll
1467 * never dereference it.
1469 srt = stgCast(StgClosure **,info->srt);
1470 srt_end = srt + info->srt_len;
1471 for (; srt < srt_end; srt++) {
1476 /* -----------------------------------------------------------------------------
1477 Scavenge a given step until there are no more objects in this step
1480 evac_gen is set by the caller to be either zero (for a step in a
1481 generation < N) or G where G is the generation of the step being
1484 We sometimes temporarily change evac_gen back to zero if we're
1485 scavenging a mutable object where early promotion isn't such a good
1487 -------------------------------------------------------------------------- */
1491 scavenge(step *step)
1494 const StgInfoTable *info;
1496 nat saved_evac_gen = evac_gen; /* used for temporarily changing evac_gen */
1501 failed_to_evac = rtsFalse;
1503 /* scavenge phase - standard breadth-first scavenging of the
1507 while (bd != step->hp_bd || p < step->hp) {
1509 /* If we're at the end of this block, move on to the next block */
1510 if (bd != step->hp_bd && p == bd->free) {
1516 q = p; /* save ptr to object */
1518 ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO((StgClosure *)p))
1519 || IS_HUGS_CONSTR_INFO(GET_INFO((StgClosure *)p))));
1521 info = get_itbl((StgClosure *)p);
1522 switch (info -> type) {
1526 StgBCO* bco = stgCast(StgBCO*,p);
1528 for (i = 0; i < bco->n_ptrs; i++) {
1529 bcoConstCPtr(bco,i) = evacuate(bcoConstCPtr(bco,i));
1531 p += bco_sizeW(bco);
1536 /* treat MVars specially, because we don't want to evacuate the
1537 * mut_link field in the middle of the closure.
1540 StgMVar *mvar = ((StgMVar *)p);
1542 (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head);
1543 (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail);
1544 (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value);
1545 p += sizeofW(StgMVar);
1546 evac_gen = saved_evac_gen;
1554 ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
1555 ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
1556 p += sizeofW(StgHeader) + 2;
1561 ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
1562 p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */
1568 ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
1569 p += sizeofW(StgHeader) + 1;
1574 p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */
1580 p += sizeofW(StgHeader) + 1;
1587 p += sizeofW(StgHeader) + 2;
1594 ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
1595 p += sizeofW(StgHeader) + 2;
1608 case IND_OLDGEN_PERM:
1614 end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
1615 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
1616 (StgClosure *)*p = evacuate((StgClosure *)*p);
1618 p += info->layout.payload.nptrs;
1623 /* ignore MUT_CONSs */
1624 if (((StgMutVar *)p)->header.info != &MUT_CONS_info) {
1626 ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
1627 evac_gen = saved_evac_gen;
1629 p += sizeofW(StgMutVar);
1634 p += BLACKHOLE_sizeW();
1639 StgBlockingQueue *bh = (StgBlockingQueue *)p;
1640 (StgClosure *)bh->blocking_queue =
1641 evacuate((StgClosure *)bh->blocking_queue);
1642 if (failed_to_evac) {
1643 failed_to_evac = rtsFalse;
1644 evacuate_mutable((StgMutClosure *)bh);
1646 p += BLACKHOLE_sizeW();
1650 case THUNK_SELECTOR:
1652 StgSelector *s = (StgSelector *)p;
1653 s->selectee = evacuate(s->selectee);
1654 p += THUNK_SELECTOR_sizeW();
1660 barf("scavenge:IND???\n");
1662 case CONSTR_INTLIKE:
1663 case CONSTR_CHARLIKE:
1665 case CONSTR_NOCAF_STATIC:
1669 /* Shouldn't see a static object here. */
1670 barf("scavenge: STATIC object\n");
1682 /* Shouldn't see stack frames here. */
1683 barf("scavenge: stack frame\n");
1685 case AP_UPD: /* same as PAPs */
1687 /* Treat a PAP just like a section of stack, not forgetting to
1688 * evacuate the function pointer too...
1691 StgPAP* pap = stgCast(StgPAP*,p);
1693 pap->fun = evacuate(pap->fun);
1694 scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
1695 p += pap_sizeW(pap);
1701 /* nothing to follow */
1702 p += arr_words_sizeW(stgCast(StgArrWords*,p));
1706 /* follow everything */
1710 evac_gen = 0; /* repeatedly mutable */
1711 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1712 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1713 (StgClosure *)*p = evacuate((StgClosure *)*p);
1715 evac_gen = saved_evac_gen;
1719 case MUT_ARR_PTRS_FROZEN:
1720 /* follow everything */
1722 StgPtr start = p, next;
1724 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1725 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1726 (StgClosure *)*p = evacuate((StgClosure *)*p);
1728 if (failed_to_evac) {
1729 /* we can do this easier... */
1730 evacuate_mutable((StgMutClosure *)start);
1731 failed_to_evac = rtsFalse;
1742 /* chase the link field for any TSOs on the same queue */
1743 (StgClosure *)tso->link = evacuate((StgClosure *)tso->link);
1744 /* scavenge this thread's stack */
1745 scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
1746 evac_gen = saved_evac_gen;
1747 p += tso_sizeW(tso);
1754 barf("scavenge: unimplemented/strange closure type\n");
1760 /* If we didn't manage to promote all the objects pointed to by
1761 * the current object, then we have to designate this object as
1762 * mutable (because it contains old-to-new generation pointers).
1764 if (failed_to_evac) {
1765 mkMutCons((StgClosure *)q, &generations[evac_gen]);
1766 failed_to_evac = rtsFalse;
1774 /* -----------------------------------------------------------------------------
1775 Scavenge one object.
1777 This is used for objects that are temporarily marked as mutable
1778 because they contain old-to-new generation pointers. Only certain
1779 objects can have this property.
1780 -------------------------------------------------------------------------- */
1782 scavenge_one(StgPtr p)
1787 ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO((StgClosure *)p))
1788 || IS_HUGS_CONSTR_INFO(GET_INFO((StgClosure *)p))));
1790 info = get_itbl((StgClosure *)p);
1792 switch (info -> type) {
1795 case FUN_1_0: /* hardly worth specialising these guys */
1815 case IND_OLDGEN_PERM:
1821 end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
1822 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
1823 (StgClosure *)*p = evacuate((StgClosure *)*p);
1832 case THUNK_SELECTOR:
1834 StgSelector *s = (StgSelector *)p;
1835 s->selectee = evacuate(s->selectee);
1839 case AP_UPD: /* same as PAPs */
1841 /* Treat a PAP just like a section of stack, not forgetting to
1842 * evacuate the function pointer too...
1845 StgPAP* pap = stgCast(StgPAP*,p);
1847 pap->fun = evacuate(pap->fun);
1848 scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
1853 /* This might happen if for instance a MUT_CONS was pointing to a
1854 * THUNK which has since been updated. The IND_OLDGEN will
1855 * be on the mutable list anyway, so we don't need to do anything
1861 barf("scavenge_one: strange object");
1864 no_luck = failed_to_evac;
1865 failed_to_evac = rtsFalse;
1870 /* -----------------------------------------------------------------------------
1871 Scavenging mutable lists.
1873 We treat the mutable list of each generation > N (i.e. all the
1874 generations older than the one being collected) as roots. We also
1875 remove non-mutable objects from the mutable list at this point.
1876 -------------------------------------------------------------------------- */
1878 static StgMutClosure *
1879 scavenge_mutable_list(StgMutClosure *p, nat gen)
1882 StgMutClosure *start;
1883 StgMutClosure **prev;
1890 failed_to_evac = rtsFalse;
1892 for (; p != END_MUT_LIST; p = *prev) {
1894 /* make sure the info pointer is into text space */
1895 ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO(p))
1896 || IS_HUGS_CONSTR_INFO(GET_INFO(p))));
1899 switch(info->type) {
1901 case MUT_ARR_PTRS_FROZEN:
1902 /* remove this guy from the mutable list, but follow the ptrs
1903 * anyway (and make sure they get promoted to this gen).
1908 end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1910 for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) {
1911 (StgClosure *)*q = evacuate((StgClosure *)*q);
1915 if (failed_to_evac) {
1916 failed_to_evac = rtsFalse;
1917 prev = &p->mut_link;
1919 *prev = p->mut_link;
1925 /* follow everything */
1926 prev = &p->mut_link;
1930 end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1931 for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) {
1932 (StgClosure *)*q = evacuate((StgClosure *)*q);
1938 /* MUT_CONS is a kind of MUT_VAR, except that we try to remove
1939 * it from the mutable list if possible by promoting whatever it
1942 if (p->header.info == &MUT_CONS_info) {
1944 if (scavenge_one((P_)((StgMutVar *)p)->var) == rtsTrue) {
1945 /* didn't manage to promote everything, so leave the
1946 * MUT_CONS on the list.
1948 prev = &p->mut_link;
1950 *prev = p->mut_link;
1954 ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
1955 prev = &p->mut_link;
1961 StgMVar *mvar = (StgMVar *)p;
1962 (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head);
1963 (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail);
1964 (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value);
1965 prev = &p->mut_link;
1970 /* follow ptrs and remove this from the mutable list */
1972 StgTSO *tso = (StgTSO *)p;
1974 /* Don't bother scavenging if this thread is dead
1976 if (!(tso->whatNext == ThreadComplete ||
1977 tso->whatNext == ThreadKilled)) {
1978 /* Don't need to chase the link field for any TSOs on the
1979 * same queue. Just scavenge this thread's stack
1981 scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
1984 /* Don't take this TSO off the mutable list - it might still
1985 * point to some younger objects (because we set evac_gen to 0
1988 prev = &tso->mut_link;
1993 case IND_OLDGEN_PERM:
1995 /* Try to pull the indirectee into this generation, so we can
1996 * remove the indirection from the mutable list.
1999 ((StgIndOldGen *)p)->indirectee =
2000 evacuate(((StgIndOldGen *)p)->indirectee);
2003 if (failed_to_evac) {
2004 failed_to_evac = rtsFalse;
2005 prev = &p->mut_link;
2007 *prev = p->mut_link;
2008 /* the mut_link field of an IND_STATIC is overloaded as the
2009 * static link field too (it just so happens that we don't need
2010 * both at the same time), so we need to NULL it out when
2011 * removing this object from the mutable list because the static
2012 * link fields are all assumed to be NULL before doing a major
2021 StgBlockingQueue *bh = (StgBlockingQueue *)p;
2022 (StgClosure *)bh->blocking_queue =
2023 evacuate((StgClosure *)bh->blocking_queue);
2024 prev = &p->mut_link;
2029 /* shouldn't have anything else on the mutables list */
2030 barf("scavenge_mutable_object: non-mutable object?");
2037 scavenge_static(void)
2039 StgClosure* p = static_objects;
2040 const StgInfoTable *info;
2042 /* Always evacuate straight to the oldest generation for static
2044 evac_gen = oldest_gen->no;
2046 /* keep going until we've scavenged all the objects on the linked
2048 while (p != END_OF_STATIC_LIST) {
2052 /* make sure the info pointer is into text space */
2053 ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO(p))
2054 || IS_HUGS_CONSTR_INFO(GET_INFO(p))));
2056 /* Take this object *off* the static_objects list,
2057 * and put it on the scavenged_static_objects list.
2059 static_objects = STATIC_LINK(info,p);
2060 STATIC_LINK(info,p) = scavenged_static_objects;
2061 scavenged_static_objects = p;
2063 switch (info -> type) {
2067 StgInd *ind = (StgInd *)p;
2068 ind->indirectee = evacuate(ind->indirectee);
2070 /* might fail to evacuate it, in which case we have to pop it
2071 * back on the mutable list (and take it off the
2072 * scavenged_static list because the static link and mut link
2073 * pointers are one and the same).
2075 if (failed_to_evac) {
2076 failed_to_evac = rtsFalse;
2077 scavenged_static_objects = STATIC_LINK(info,p);
2078 ((StgMutClosure *)ind)->mut_link = oldest_gen->mut_list;
2079 oldest_gen->mut_list = (StgMutClosure *)ind;
2093 next = (P_)p->payload + info->layout.payload.ptrs;
2094 /* evacuate the pointers */
2095 for (q = (P_)p->payload; q < next; q++) {
2096 (StgClosure *)*q = evacuate((StgClosure *)*q);
2102 barf("scavenge_static");
2105 ASSERT(failed_to_evac == rtsFalse);
2107 /* get the next static object from the list. Remeber, there might
2108 * be more stuff on this list now that we've done some evacuating!
2109 * (static_objects is a global)
2115 /* -----------------------------------------------------------------------------
2116 scavenge_stack walks over a section of stack and evacuates all the
2117 objects pointed to by it. We can use the same code for walking
2118 PAPs, since these are just sections of copied stack.
2119 -------------------------------------------------------------------------- */
2122 scavenge_stack(StgPtr p, StgPtr stack_end)
2125 const StgInfoTable* info;
2129 * Each time around this loop, we are looking at a chunk of stack
2130 * that starts with either a pending argument section or an
2131 * activation record.
2134 while (p < stack_end) {
2135 q = *stgCast(StgPtr*,p);
2137 /* If we've got a tag, skip over that many words on the stack */
2138 if (IS_ARG_TAG(stgCast(StgWord,q))) {
2143 /* Is q a pointer to a closure?
2145 if (! LOOKS_LIKE_GHC_INFO(q)) {
2148 if (LOOKS_LIKE_STATIC(q)) { /* Is it a static closure? */
2149 ASSERT(closure_STATIC(stgCast(StgClosure*,q)));
2151 /* otherwise, must be a pointer into the allocation space.
2155 (StgClosure *)*p = evacuate((StgClosure *)q);
2161 * Otherwise, q must be the info pointer of an activation
2162 * record. All activation records have 'bitmap' style layout
2165 info = get_itbl(stgCast(StgClosure*,p));
2167 switch (info->type) {
2169 /* Dynamic bitmap: the mask is stored on the stack */
2171 bitmap = stgCast(StgRetDyn*,p)->liveness;
2172 p = &payloadWord(stgCast(StgRetDyn*,p),0);
2175 /* probably a slow-entry point return address: */
2181 /* Specialised code for update frames, since they're so common.
2182 * We *know* the updatee points to a BLACKHOLE, CAF_BLACKHOLE,
2183 * or BLACKHOLE_BQ, so just inline the code to evacuate it here.
2187 StgUpdateFrame *frame = (StgUpdateFrame *)p;
2189 StgClosureType type = get_itbl(frame->updatee)->type;
2191 p += sizeofW(StgUpdateFrame);
2192 if (type == EVACUATED) {
2193 frame->updatee = evacuate(frame->updatee);
2196 bdescr *bd = Bdescr((P_)frame->updatee);
2198 if (bd->gen->no > N) {
2199 if (bd->gen->no < evac_gen) {
2200 failed_to_evac = rtsTrue;
2204 step = bd->step->to;
2208 to = copyPart(frame->updatee, BLACKHOLE_sizeW(),
2209 sizeofW(StgHeader), step);
2210 upd_evacuee(frame->updatee,to);
2211 frame->updatee = to;
2214 to = copy(frame->updatee, BLACKHOLE_sizeW(), step);
2215 upd_evacuee(frame->updatee,to);
2216 frame->updatee = to;
2217 evacuate_mutable((StgMutClosure *)to);
2220 barf("scavenge_stack: UPDATE_FRAME updatee");
2225 /* small bitmap (< 32 entries, or 64 on a 64-bit machine) */
2232 bitmap = info->layout.bitmap;
2235 while (bitmap != 0) {
2236 if ((bitmap & 1) == 0) {
2237 (StgClosure *)*p = evacuate((StgClosure *)*p);
2240 bitmap = bitmap >> 1;
2247 /* large bitmap (> 32 entries) */
2252 StgLargeBitmap *large_bitmap;
2255 large_bitmap = info->layout.large_bitmap;
2258 for (i=0; i<large_bitmap->size; i++) {
2259 bitmap = large_bitmap->bitmap[i];
2260 q = p + sizeof(W_) * 8;
2261 while (bitmap != 0) {
2262 if ((bitmap & 1) == 0) {
2263 (StgClosure *)*p = evacuate((StgClosure *)*p);
2266 bitmap = bitmap >> 1;
2268 if (i+1 < large_bitmap->size) {
2270 (StgClosure *)*p = evacuate((StgClosure *)*p);
2276 /* and don't forget to follow the SRT */
2281 barf("scavenge_stack: weird activation record found on stack.\n");
2286 /*-----------------------------------------------------------------------------
2287 scavenge the large object list.
2289 evac_gen set by caller; similar games played with evac_gen as with
2290 scavenge() - see comment at the top of scavenge(). Most large
2291 objects are (repeatedly) mutable, so most of the time evac_gen will
2293 --------------------------------------------------------------------------- */
2296 scavenge_large(step *step)
2300 const StgInfoTable* info;
2301 nat saved_evac_gen = evac_gen; /* used for temporarily changing evac_gen */
2303 evac_gen = 0; /* most objects are mutable */
2304 bd = step->new_large_objects;
2306 for (; bd != NULL; bd = step->new_large_objects) {
2308 /* take this object *off* the large objects list and put it on
2309 * the scavenged large objects list. This is so that we can
2310 * treat new_large_objects as a stack and push new objects on
2311 * the front when evacuating.
2313 step->new_large_objects = bd->link;
2314 dbl_link_onto(bd, &step->scavenged_large_objects);
2317 info = get_itbl(stgCast(StgClosure*,p));
2319 switch (info->type) {
2321 /* only certain objects can be "large"... */
2325 /* nothing to follow */
2329 /* follow everything */
2333 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
2334 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
2335 (StgClosure *)*p = evacuate((StgClosure *)*p);
2340 case MUT_ARR_PTRS_FROZEN:
2341 /* follow everything */
2343 StgPtr start = p, next;
2345 evac_gen = saved_evac_gen; /* not really mutable */
2346 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
2347 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
2348 (StgClosure *)*p = evacuate((StgClosure *)*p);
2351 if (failed_to_evac) {
2352 evacuate_mutable((StgMutClosure *)start);
2359 StgBCO* bco = stgCast(StgBCO*,p);
2361 evac_gen = saved_evac_gen;
2362 for (i = 0; i < bco->n_ptrs; i++) {
2363 bcoConstCPtr(bco,i) = evacuate(bcoConstCPtr(bco,i));
2374 /* chase the link field for any TSOs on the same queue */
2375 (StgClosure *)tso->link = evacuate((StgClosure *)tso->link);
2376 /* scavenge this thread's stack */
2377 scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
2382 barf("scavenge_large: unknown/strange object");
2388 zeroStaticObjectList(StgClosure* first_static)
2392 const StgInfoTable *info;
2394 for (p = first_static; p != END_OF_STATIC_LIST; p = link) {
2396 link = STATIC_LINK(info, p);
2397 STATIC_LINK(info,p) = NULL;
2401 /* This function is only needed because we share the mutable link
2402 * field with the static link field in an IND_STATIC, so we have to
2403 * zero the mut_link field before doing a major GC, which needs the
2404 * static link field.
2406 * It doesn't do any harm to zero all the mutable link fields on the
2410 zeroMutableList(StgMutClosure *first)
2412 StgMutClosure *next, *c;
2414 for (c = first; c != END_MUT_LIST; c = next) {
2420 /* -----------------------------------------------------------------------------
2422 -------------------------------------------------------------------------- */
2424 void RevertCAFs(void)
2426 while (enteredCAFs != END_CAF_LIST) {
2427 StgCAF* caf = enteredCAFs;
2429 enteredCAFs = caf->link;
2430 ASSERT(get_itbl(caf)->type == CAF_ENTERED);
2431 SET_INFO(caf,&CAF_UNENTERED_info);
2432 caf->value = stgCast(StgClosure*,0xdeadbeef);
2433 caf->link = stgCast(StgCAF*,0xdeadbeef);
2437 void revertDeadCAFs(void)
2439 StgCAF* caf = enteredCAFs;
2440 enteredCAFs = END_CAF_LIST;
2441 while (caf != END_CAF_LIST) {
2442 StgCAF* next = caf->link;
2444 switch(GET_INFO(caf)->type) {
2447 /* This object has been evacuated, it must be live. */
2448 StgCAF* new = stgCast(StgCAF*,stgCast(StgEvacuated*,caf)->evacuee);
2449 new->link = enteredCAFs;
2455 SET_INFO(caf,&CAF_UNENTERED_info);
2456 caf->value = stgCast(StgClosure*,0xdeadbeef);
2457 caf->link = stgCast(StgCAF*,0xdeadbeef);
2461 barf("revertDeadCAFs: enteredCAFs list corrupted");
2467 /* -----------------------------------------------------------------------------
2468 Sanity code for CAF garbage collection.
2470 With DEBUG turned on, we manage a CAF list in addition to the SRT
2471 mechanism. After GC, we run down the CAF list and blackhole any
2472 CAFs which have been garbage collected. This means we get an error
2473 whenever the program tries to enter a garbage collected CAF.
2475 Any garbage collected CAFs are taken off the CAF list at the same
2477 -------------------------------------------------------------------------- */
2485 const StgInfoTable *info;
2496 ASSERT(info->type == IND_STATIC);
2498 if (STATIC_LINK(info,p) == NULL) {
2499 IF_DEBUG(gccafs, fprintf(stderr, "CAF gc'd at 0x%04x\n", (int)p));
2501 SET_INFO(p,&BLACKHOLE_info);
2502 p = STATIC_LINK2(info,p);
2506 pp = &STATIC_LINK2(info,p);
2513 /* fprintf(stderr, "%d CAFs live\n", i); */
2517 /* -----------------------------------------------------------------------------
2520 Whenever a thread returns to the scheduler after possibly doing
2521 some work, we have to run down the stack and black-hole all the
2522 closures referred to by update frames.
2523 -------------------------------------------------------------------------- */
2526 threadLazyBlackHole(StgTSO *tso)
2528 StgUpdateFrame *update_frame;
2529 StgBlockingQueue *bh;
2532 stack_end = &tso->stack[tso->stack_size];
2533 update_frame = tso->su;
2536 switch (get_itbl(update_frame)->type) {
2539 update_frame = stgCast(StgCatchFrame*,update_frame)->link;
2543 bh = (StgBlockingQueue *)update_frame->updatee;
2545 /* if the thunk is already blackholed, it means we've also
2546 * already blackholed the rest of the thunks on this stack,
2547 * so we can stop early.
2549 * The blackhole made for a CAF is a CAF_BLACKHOLE, so they
2550 * don't interfere with this optimisation.
2552 if (bh->header.info == &BLACKHOLE_info) {
2556 if (bh->header.info != &BLACKHOLE_BQ_info &&
2557 bh->header.info != &CAF_BLACKHOLE_info) {
2558 SET_INFO(bh,&BLACKHOLE_info);
2561 update_frame = update_frame->link;
2565 update_frame = stgCast(StgSeqFrame*,update_frame)->link;
2571 barf("threadPaused");
2576 /* -----------------------------------------------------------------------------
2579 * Code largely pinched from old RTS, then hacked to bits. We also do
2580 * lazy black holing here.
2582 * -------------------------------------------------------------------------- */
2585 threadSqueezeStack(StgTSO *tso)
2587 lnat displacement = 0;
2588 StgUpdateFrame *frame;
2589 StgUpdateFrame *next_frame; /* Temporally next */
2590 StgUpdateFrame *prev_frame; /* Temporally previous */
2592 rtsBool prev_was_update_frame;
2594 bottom = &(tso->stack[tso->stack_size]);
2597 /* There must be at least one frame, namely the STOP_FRAME.
2599 ASSERT((P_)frame < bottom);
2601 /* Walk down the stack, reversing the links between frames so that
2602 * we can walk back up as we squeeze from the bottom. Note that
2603 * next_frame and prev_frame refer to next and previous as they were
2604 * added to the stack, rather than the way we see them in this
2605 * walk. (It makes the next loop less confusing.)
2607 * Stop if we find an update frame pointing to a black hole
2608 * (see comment in threadLazyBlackHole()).
2612 while ((P_)frame < bottom - 1) { /* bottom - 1 is the STOP_FRAME */
2613 prev_frame = frame->link;
2614 frame->link = next_frame;
2617 if (get_itbl(frame)->type == UPDATE_FRAME
2618 && frame->updatee->header.info == &BLACKHOLE_info) {
2623 /* Now, we're at the bottom. Frame points to the lowest update
2624 * frame on the stack, and its link actually points to the frame
2625 * above. We have to walk back up the stack, squeezing out empty
2626 * update frames and turning the pointers back around on the way
2629 * The bottom-most frame (the STOP_FRAME) has not been altered, and
2630 * we never want to eliminate it anyway. Just walk one step up
2631 * before starting to squeeze. When you get to the topmost frame,
2632 * remember that there are still some words above it that might have
2639 prev_was_update_frame = (get_itbl(prev_frame)->type == UPDATE_FRAME);
2642 * Loop through all of the frames (everything except the very
2643 * bottom). Things are complicated by the fact that we have
2644 * CATCH_FRAMEs and SEQ_FRAMEs interspersed with the update frames.
2645 * We can only squeeze when there are two consecutive UPDATE_FRAMEs.
2647 while (frame != NULL) {
2649 StgPtr frame_bottom = (P_)frame + sizeofW(StgUpdateFrame);
2650 rtsBool is_update_frame;
2652 next_frame = frame->link;
2653 is_update_frame = (get_itbl(frame)->type == UPDATE_FRAME);
2656 * 1. both the previous and current frame are update frames
2657 * 2. the current frame is empty
2659 if (prev_was_update_frame && is_update_frame &&
2660 (P_)prev_frame == frame_bottom + displacement) {
2662 /* Now squeeze out the current frame */
2663 StgClosure *updatee_keep = prev_frame->updatee;
2664 StgClosure *updatee_bypass = frame->updatee;
2667 fprintf(stderr, "squeezing frame at %p\n", frame);
2670 /* Deal with blocking queues. If both updatees have blocked
2671 * threads, then we should merge the queues into the update
2672 * frame that we're keeping.
2674 * Alternatively, we could just wake them up: they'll just go
2675 * straight to sleep on the proper blackhole! This is less code
2676 * and probably less bug prone, although it's probably much
2679 #if 0 /* do it properly... */
2680 if (GET_INFO(updatee_bypass) == BLACKHOLE_BQ_info) {
2681 /* Sigh. It has one. Don't lose those threads! */
2682 if (GET_INFO(updatee_keep) == BLACKHOLE_BQ_info) {
2683 /* Urgh. Two queues. Merge them. */
2684 P_ keep_tso = ((StgBlockingQueue *)updatee_keep)->blocking_queue;
2686 while (keep_tso->link != END_TSO_QUEUE) {
2687 keep_tso = keep_tso->link;
2689 keep_tso->link = ((StgBlockingQueue *)updatee_bypass)->blocking_queue;
2692 /* For simplicity, just swap the BQ for the BH */
2693 P_ temp = updatee_keep;
2695 updatee_keep = updatee_bypass;
2696 updatee_bypass = temp;
2698 /* Record the swap in the kept frame (below) */
2699 prev_frame->updatee = updatee_keep;
2704 TICK_UPD_SQUEEZED();
2705 UPD_IND(updatee_bypass, updatee_keep); /* this wakes the threads up */
2707 sp = (P_)frame - 1; /* sp = stuff to slide */
2708 displacement += sizeofW(StgUpdateFrame);
2711 /* No squeeze for this frame */
2712 sp = frame_bottom - 1; /* Keep the current frame */
2714 /* Do lazy black-holing.
2716 if (is_update_frame) {
2717 StgBlockingQueue *bh = (StgBlockingQueue *)frame->updatee;
2718 if (bh->header.info != &BLACKHOLE_BQ_info &&
2719 bh->header.info != &CAF_BLACKHOLE_info) {
2720 SET_INFO(bh,&BLACKHOLE_info);
2724 /* Fix the link in the current frame (should point to the frame below) */
2725 frame->link = prev_frame;
2726 prev_was_update_frame = is_update_frame;
2729 /* Now slide all words from sp up to the next frame */
2731 if (displacement > 0) {
2732 P_ next_frame_bottom;
2734 if (next_frame != NULL)
2735 next_frame_bottom = (P_)next_frame + sizeofW(StgUpdateFrame);
2737 next_frame_bottom = tso->sp - 1;
2740 fprintf(stderr, "sliding [%p, %p] by %ld\n", sp, next_frame_bottom,
2744 while (sp >= next_frame_bottom) {
2745 sp[displacement] = *sp;
2749 (P_)prev_frame = (P_)frame + displacement;
2753 tso->sp += displacement;
2754 tso->su = prev_frame;
2757 /* -----------------------------------------------------------------------------
2760 * We have to prepare for GC - this means doing lazy black holing
2761 * here. We also take the opportunity to do stack squeezing if it's
2763 * -------------------------------------------------------------------------- */
2766 threadPaused(StgTSO *tso)
2768 if ( RtsFlags.GcFlags.squeezeUpdFrames == rtsTrue )
2769 threadSqueezeStack(tso); /* does black holing too */
2771 threadLazyBlackHole(tso);