1 /* -----------------------------------------------------------------------------
2 * $Id: GC.c,v 1.25 1999/02/05 14:49:22 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 void scavenge_mutable_list(generation *g);
107 static void scavenge_mut_once_list(generation *g);
110 static void gcCAFs(void);
113 /* -----------------------------------------------------------------------------
116 For garbage collecting generation N (and all younger generations):
118 - follow all pointers in the root set. the root set includes all
119 mutable objects in all steps in all generations.
121 - for each pointer, evacuate the object it points to into either
122 + to-space in the next higher step in that generation, if one exists,
123 + if the object's generation == N, then evacuate it to the next
124 generation if one exists, or else to-space in the current
126 + if the object's generation < N, then evacuate it to to-space
127 in the next generation.
129 - repeatedly scavenge to-space from each step in each generation
130 being collected until no more objects can be evacuated.
132 - free from-space in each step, and set from-space = to-space.
134 -------------------------------------------------------------------------- */
136 void GarbageCollect(void (*get_roots)(void))
140 lnat live, allocated, collected = 0;
144 CostCentreStack *prev_CCS;
147 /* tell the stats department that we've started a GC */
150 /* attribute any costs to CCS_GC */
156 /* We might have been called from Haskell land by _ccall_GC, in
157 * which case we need to call threadPaused() because the scheduler
158 * won't have done it.
160 if (CurrentTSO) { threadPaused(CurrentTSO); }
162 /* Approximate how much we allocated: number of blocks in the
163 * nursery + blocks allocated via allocate() - unused nusery blocks.
164 * This leaves a little slop at the end of each block, and doesn't
165 * take into account large objects (ToDo).
167 allocated = (nursery_blocks * BLOCK_SIZE_W) + allocated_bytes();
168 for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
169 allocated -= BLOCK_SIZE_W;
172 /* Figure out which generation to collect
175 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
176 if (generations[g].steps[0].n_blocks >= generations[g].max_blocks) {
180 major_gc = (N == RtsFlags.GcFlags.generations-1);
182 /* check stack sanity *before* GC (ToDo: check all threads) */
183 /*IF_DEBUG(sanity, checkTSO(MainTSO,0)); */
184 IF_DEBUG(sanity, checkFreeListSanity());
186 /* Initialise the static object lists
188 static_objects = END_OF_STATIC_LIST;
189 scavenged_static_objects = END_OF_STATIC_LIST;
191 /* zero the mutable list for the oldest generation (see comment by
192 * zeroMutableList below).
195 zeroMutableList(generations[RtsFlags.GcFlags.generations-1].mut_once_list);
198 /* Save the old to-space if we're doing a two-space collection
200 if (RtsFlags.GcFlags.generations == 1) {
201 old_to_space = g0s0->to_space;
202 g0s0->to_space = NULL;
205 /* Initialise to-space in all the generations/steps that we're
208 for (g = 0; g <= N; g++) {
209 generations[g].mut_once_list = END_MUT_LIST;
210 generations[g].mut_list = END_MUT_LIST;
212 for (s = 0; s < generations[g].n_steps; s++) {
214 /* generation 0, step 0 doesn't need to-space */
215 if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) {
219 /* Get a free block for to-space. Extra blocks will be chained on
223 step = &generations[g].steps[s];
224 ASSERT(step->gen->no == g);
225 ASSERT(step->hp ? Bdescr(step->hp)->step == step : rtsTrue);
226 bd->gen = &generations[g];
229 bd->evacuated = 1; /* it's a to-space block */
230 step->hp = bd->start;
231 step->hpLim = step->hp + BLOCK_SIZE_W;
234 step->to_blocks = 1; /* ???? */
235 step->scan = bd->start;
237 step->new_large_objects = NULL;
238 step->scavenged_large_objects = NULL;
239 /* mark the large objects as not evacuated yet */
240 for (bd = step->large_objects; bd; bd = bd->link) {
246 /* make sure the older generations have at least one block to
247 * allocate into (this makes things easier for copy(), see below.
249 for (g = N+1; g < RtsFlags.GcFlags.generations; g++) {
250 for (s = 0; s < generations[g].n_steps; s++) {
251 step = &generations[g].steps[s];
252 if (step->hp_bd == NULL) {
254 bd->gen = &generations[g];
257 bd->evacuated = 0; /* *not* a to-space block */
258 step->hp = bd->start;
259 step->hpLim = step->hp + BLOCK_SIZE_W;
264 /* Set the scan pointer for older generations: remember we
265 * still have to scavenge objects that have been promoted. */
266 step->scan = step->hp;
267 step->scan_bd = step->hp_bd;
268 step->to_space = NULL;
270 step->new_large_objects = NULL;
271 step->scavenged_large_objects = NULL;
275 /* -----------------------------------------------------------------------
276 * follow all the roots that we know about:
277 * - mutable lists from each generation > N
278 * we want to *scavenge* these roots, not evacuate them: they're not
279 * going to move in this GC.
280 * Also: do them in reverse generation order. This is because we
281 * often want to promote objects that are pointed to by older
282 * generations early, so we don't have to repeatedly copy them.
283 * Doing the generations in reverse order ensures that we don't end
284 * up in the situation where we want to evac an object to gen 3 and
285 * it has already been evaced to gen 2.
289 for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
290 generations[g].saved_mut_list = generations[g].mut_list;
291 generations[g].mut_list = END_MUT_LIST;
294 /* Do the mut-once lists first */
295 for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
296 scavenge_mut_once_list(&generations[g]);
298 for (st = generations[g].n_steps-1; st >= 0; st--) {
299 scavenge(&generations[g].steps[st]);
303 for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
304 scavenge_mutable_list(&generations[g]);
306 for (st = generations[g].n_steps-1; st >= 0; st--) {
307 scavenge(&generations[g].steps[st]);
312 /* follow all the roots that the application knows about.
317 /* And don't forget to mark the TSO if we got here direct from
320 CurrentTSO = (StgTSO *)MarkRoot((StgClosure *)CurrentTSO);
323 /* Mark the weak pointer list, and prepare to detect dead weak
327 old_weak_ptr_list = weak_ptr_list;
328 weak_ptr_list = NULL;
329 weak_done = rtsFalse;
331 /* Mark the stable pointer table.
333 markStablePtrTable(major_gc);
337 /* ToDo: To fix the caf leak, we need to make the commented out
338 * parts of this code do something sensible - as described in
341 extern void markHugsObjects(void);
343 /* ToDo: This (undefined) function should contain the scavenge
344 * loop immediately below this block of code - but I'm not sure
345 * enough of the details to do this myself.
347 scavengeEverything();
348 /* revert dead CAFs and update enteredCAFs list */
353 /* This will keep the CAFs and the attached BCOs alive
354 * but the values will have been reverted
356 scavengeEverything();
361 /* -------------------------------------------------------------------------
362 * Repeatedly scavenge all the areas we know about until there's no
363 * more scavenging to be done.
370 /* scavenge static objects */
371 if (major_gc && static_objects != END_OF_STATIC_LIST) {
375 /* When scavenging the older generations: Objects may have been
376 * evacuated from generations <= N into older generations, and we
377 * need to scavenge these objects. We're going to try to ensure that
378 * any evacuations that occur move the objects into at least the
379 * same generation as the object being scavenged, otherwise we
380 * have to create new entries on the mutable list for the older
384 /* scavenge each step in generations 0..maxgen */
388 for (gen = RtsFlags.GcFlags.generations-1; gen >= 0; gen--) {
389 for (st = generations[gen].n_steps-1; st >= 0 ; st--) {
390 step = &generations[gen].steps[st];
392 if (step->hp_bd != step->scan_bd || step->scan < step->hp) {
397 if (step->new_large_objects != NULL) {
398 scavenge_large(step);
405 if (flag) { goto loop; }
407 /* must be last... */
408 if (traverse_weak_ptr_list()) { /* returns rtsTrue if evaced something */
413 /* Now see which stable names are still alive
415 gcStablePtrTable(major_gc);
417 /* Set the maximum blocks for the oldest generation, based on twice
418 * the amount of live data now, adjusted to fit the maximum heap
421 * This is an approximation, since in the worst case we'll need
422 * twice the amount of live data plus whatever space the other
425 if (RtsFlags.GcFlags.generations > 1) {
427 oldest_gen->max_blocks =
428 stg_max(oldest_gen->steps[0].to_blocks * RtsFlags.GcFlags.oldGenFactor,
429 RtsFlags.GcFlags.minOldGenSize);
430 if (oldest_gen->max_blocks > RtsFlags.GcFlags.maxHeapSize / 2) {
431 oldest_gen->max_blocks = RtsFlags.GcFlags.maxHeapSize / 2;
432 if (((int)oldest_gen->max_blocks -
433 (int)oldest_gen->steps[0].to_blocks) <
434 (RtsFlags.GcFlags.pcFreeHeap *
435 RtsFlags.GcFlags.maxHeapSize / 200)) {
442 /* run through all the generations/steps and tidy up
444 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
447 generations[g].collections++; /* for stats */
450 for (s = 0; s < generations[g].n_steps; s++) {
452 step = &generations[g].steps[s];
454 if (!(g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1)) {
455 /* Tidy the end of the to-space chains */
456 step->hp_bd->free = step->hp;
457 step->hp_bd->link = NULL;
460 /* for generations we collected... */
463 collected += step->n_blocks * BLOCK_SIZE_W; /* for stats */
465 /* free old memory and shift to-space into from-space for all
466 * the collected steps (except the allocation area). These
467 * freed blocks will probaby be quickly recycled.
469 if (!(g == 0 && s == 0)) {
470 freeChain(step->blocks);
471 step->blocks = step->to_space;
472 step->n_blocks = step->to_blocks;
473 step->to_space = NULL;
475 for (bd = step->blocks; bd != NULL; bd = bd->link) {
476 bd->evacuated = 0; /* now from-space */
480 /* LARGE OBJECTS. The current live large objects are chained on
481 * scavenged_large, having been moved during garbage
482 * collection from large_objects. Any objects left on
483 * large_objects list are therefore dead, so we free them here.
485 for (bd = step->large_objects; bd != NULL; bd = next) {
490 for (bd = step->scavenged_large_objects; bd != NULL; bd = bd->link) {
493 step->large_objects = step->scavenged_large_objects;
495 /* Set the maximum blocks for this generation, interpolating
496 * between the maximum size of the oldest and youngest
499 * max_blocks = oldgen_max_blocks * G
500 * ----------------------
504 generations[g].max_blocks = (oldest_gen->max_blocks * g)
505 / (RtsFlags.GcFlags.generations-1);
508 /* for older generations... */
511 /* For older generations, we need to append the
512 * scavenged_large_object list (i.e. large objects that have been
513 * promoted during this GC) to the large_object list for that step.
515 for (bd = step->scavenged_large_objects; bd; bd = next) {
518 dbl_link_onto(bd, &step->large_objects);
521 /* add the new blocks we promoted during this GC */
522 step->n_blocks += step->to_blocks;
527 /* Guess the amount of live data for stats. */
530 /* Two-space collector:
531 * Free the old to-space, and estimate the amount of live data.
533 if (RtsFlags.GcFlags.generations == 1) {
536 if (old_to_space != NULL) {
537 freeChain(old_to_space);
539 for (bd = g0s0->to_space; bd != NULL; bd = bd->link) {
540 bd->evacuated = 0; /* now from-space */
543 /* For a two-space collector, we need to resize the nursery. */
545 /* set up a new nursery. Allocate a nursery size based on a
546 * function of the amount of live data (currently a factor of 2,
547 * should be configurable (ToDo)). Use the blocks from the old
548 * nursery if possible, freeing up any left over blocks.
550 * If we get near the maximum heap size, then adjust our nursery
551 * size accordingly. If the nursery is the same size as the live
552 * data (L), then we need 3L bytes. We can reduce the size of the
553 * nursery to bring the required memory down near 2L bytes.
555 * A normal 2-space collector would need 4L bytes to give the same
556 * performance we get from 3L bytes, reducing to the same
557 * performance at 2L bytes.
559 blocks = g0s0->n_blocks;
561 if ( blocks * RtsFlags.GcFlags.oldGenFactor * 2 >
562 RtsFlags.GcFlags.maxHeapSize ) {
563 int adjusted_blocks; /* signed on purpose */
566 adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);
567 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));
568 pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize;
569 if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even be < 0 */ {
572 blocks = adjusted_blocks;
575 blocks *= RtsFlags.GcFlags.oldGenFactor;
576 if (blocks < RtsFlags.GcFlags.minAllocAreaSize) {
577 blocks = RtsFlags.GcFlags.minAllocAreaSize;
580 resizeNursery(blocks);
583 /* Generational collector:
584 * If the user has given us a suggested heap size, adjust our
585 * allocation area to make best use of the memory available.
588 if (RtsFlags.GcFlags.heapSizeSuggestion) {
590 nat needed = calcNeeded(); /* approx blocks needed at next GC */
592 /* Guess how much will be live in generation 0 step 0 next time.
593 * A good approximation is the amount of data that was live this
594 * time: this assumes (1) that the size of G0S0 will be roughly
595 * the same as last time, and (2) that the promotion rate will be
598 * If we don't know how much was live in G0S0 (because there's no
599 * step 1), then assume 30% (which is usually an overestimate).
601 if (g0->n_steps == 1) {
602 needed += (g0s0->n_blocks * 30) / 100;
604 needed += g0->steps[1].n_blocks;
607 /* Now we have a rough guess at the number of blocks needed for
608 * the next GC, subtract this from the user's suggested heap size
609 * and use the rest for the allocation area.
611 blocks = (int)RtsFlags.GcFlags.heapSizeSuggestion - (int)needed;
613 if (blocks < (int)RtsFlags.GcFlags.minAllocAreaSize) {
614 blocks = RtsFlags.GcFlags.minAllocAreaSize;
617 resizeNursery((nat)blocks);
621 /* revert dead CAFs and update enteredCAFs list */
624 /* mark the garbage collected CAFs as dead */
626 if (major_gc) { gcCAFs(); }
629 /* zero the scavenged static object list */
631 zeroStaticObjectList(scavenged_static_objects);
636 for (bd = g0s0->blocks; bd; bd = bd->link) {
637 bd->free = bd->start;
638 ASSERT(bd->gen == g0);
639 ASSERT(bd->step == g0s0);
641 current_nursery = g0s0->blocks;
643 /* Free the small objects allocated via allocate(), since this will
644 * all have been copied into G0S1 now.
646 if (small_alloc_list != NULL) {
647 freeChain(small_alloc_list);
649 small_alloc_list = NULL;
651 alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
653 /* start any pending finalisers */
654 scheduleFinalisers(old_weak_ptr_list);
656 /* check sanity after GC */
657 IF_DEBUG(sanity, checkSanity(N));
659 /* extra GC trace info */
660 IF_DEBUG(gc, stat_describe_gens());
663 /* symbol-table based profiling */
664 /* heapCensus(to_space); */ /* ToDo */
667 /* restore enclosing cost centre */
672 /* check for memory leaks if sanity checking is on */
673 IF_DEBUG(sanity, memInventory());
675 /* ok, GC over: tell the stats department what happened. */
676 stat_endGC(allocated, collected, live, N);
679 /* -----------------------------------------------------------------------------
682 traverse_weak_ptr_list is called possibly many times during garbage
683 collection. It returns a flag indicating whether it did any work
684 (i.e. called evacuate on any live pointers).
686 Invariant: traverse_weak_ptr_list is called when the heap is in an
687 idempotent state. That means that there are no pending
688 evacuate/scavenge operations. This invariant helps the weak
689 pointer code decide which weak pointers are dead - if there are no
690 new live weak pointers, then all the currently unreachable ones are
693 For generational GC: we just don't try to finalise weak pointers in
694 older generations than the one we're collecting. This could
695 probably be optimised by keeping per-generation lists of weak
696 pointers, but for a few weak pointers this scheme will work.
697 -------------------------------------------------------------------------- */
700 traverse_weak_ptr_list(void)
702 StgWeak *w, **last_w, *next_w;
704 rtsBool flag = rtsFalse;
706 if (weak_done) { return rtsFalse; }
708 /* doesn't matter where we evacuate values/finalisers to, since
709 * these pointers are treated as roots (iff the keys are alive).
713 last_w = &old_weak_ptr_list;
714 for (w = old_weak_ptr_list; w; w = next_w) {
716 if ((new = isAlive(w->key))) {
718 /* evacuate the value and finaliser */
719 w->value = evacuate(w->value);
720 w->finaliser = evacuate(w->finaliser);
721 /* remove this weak ptr from the old_weak_ptr list */
723 /* and put it on the new weak ptr list */
725 w->link = weak_ptr_list;
728 IF_DEBUG(weak, fprintf(stderr,"Weak pointer still alive at %p -> %p\n", w, w->key));
738 /* If we didn't make any changes, then we can go round and kill all
739 * the dead weak pointers. The old_weak_ptr list is used as a list
740 * of pending finalisers later on.
742 if (flag == rtsFalse) {
743 for (w = old_weak_ptr_list; w; w = w->link) {
744 w->value = evacuate(w->value);
745 w->finaliser = evacuate(w->finaliser);
753 /* -----------------------------------------------------------------------------
754 isAlive determines whether the given closure is still alive (after
755 a garbage collection) or not. It returns the new address of the
756 closure if it is alive, or NULL otherwise.
757 -------------------------------------------------------------------------- */
760 isAlive(StgClosure *p)
768 /* ToDo: for static closures, check the static link field.
769 * Problem here is that we sometimes don't set the link field, eg.
770 * for static closures with an empty SRT or CONSTR_STATIC_NOCAFs.
773 /* ignore closures in generations that we're not collecting. */
774 if (LOOKS_LIKE_STATIC(p) || Bdescr((P_)p)->gen->no > N) {
778 switch (info->type) {
783 case IND_OLDGEN: /* rely on compatible layout with StgInd */
784 case IND_OLDGEN_PERM:
785 /* follow indirections */
786 p = ((StgInd *)p)->indirectee;
791 return ((StgEvacuated *)p)->evacuee;
801 MarkRoot(StgClosure *root)
803 return evacuate(root);
806 static void addBlock(step *step)
808 bdescr *bd = allocBlock();
812 if (step->gen->no <= N) {
818 step->hp_bd->free = step->hp;
819 step->hp_bd->link = bd;
820 step->hp = bd->start;
821 step->hpLim = step->hp + BLOCK_SIZE_W;
826 static __inline__ StgClosure *
827 copy(StgClosure *src, nat size, step *step)
831 TICK_GC_WORDS_COPIED(size);
832 /* Find out where we're going, using the handy "to" pointer in
833 * the step of the source object. If it turns out we need to
834 * evacuate to an older generation, adjust it here (see comment
837 if (step->gen->no < evac_gen) {
838 step = &generations[evac_gen].steps[0];
841 /* chain a new block onto the to-space for the destination step if
844 if (step->hp + size >= step->hpLim) {
848 for(to = step->hp, from = (P_)src; size>0; --size) {
854 return (StgClosure *)dest;
857 /* Special version of copy() for when we only want to copy the info
858 * pointer of an object, but reserve some padding after it. This is
859 * used to optimise evacuation of BLACKHOLEs.
862 static __inline__ StgClosure *
863 copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *step)
867 TICK_GC_WORDS_COPIED(size_to_copy);
868 if (step->gen->no < evac_gen) {
869 step = &generations[evac_gen].steps[0];
872 if (step->hp + size_to_reserve >= step->hpLim) {
876 for(to = step->hp, from = (P_)src; size_to_copy>0; --size_to_copy) {
881 step->hp += size_to_reserve;
882 return (StgClosure *)dest;
885 static __inline__ void
886 upd_evacuee(StgClosure *p, StgClosure *dest)
888 StgEvacuated *q = (StgEvacuated *)p;
890 SET_INFO(q,&EVACUATED_info);
894 /* -----------------------------------------------------------------------------
895 Evacuate a large object
897 This just consists of removing the object from the (doubly-linked)
898 large_alloc_list, and linking it on to the (singly-linked)
899 new_large_objects list, from where it will be scavenged later.
901 Convention: bd->evacuated is /= 0 for a large object that has been
902 evacuated, or 0 otherwise.
903 -------------------------------------------------------------------------- */
906 evacuate_large(StgPtr p, rtsBool mutable)
908 bdescr *bd = Bdescr(p);
911 /* should point to the beginning of the block */
912 ASSERT(((W_)p & BLOCK_MASK) == 0);
914 /* already evacuated? */
916 /* Don't forget to set the failed_to_evac flag if we didn't get
917 * the desired destination (see comments in evacuate()).
919 if (bd->gen->no < evac_gen) {
920 failed_to_evac = rtsTrue;
921 TICK_GC_FAILED_PROMOTION();
927 /* remove from large_object list */
929 bd->back->link = bd->link;
930 } else { /* first object in the list */
931 step->large_objects = bd->link;
934 bd->link->back = bd->back;
937 /* link it on to the evacuated large object list of the destination step
940 if (step->gen->no < evac_gen) {
941 step = &generations[evac_gen].steps[0];
946 bd->link = step->new_large_objects;
947 step->new_large_objects = bd;
951 recordMutable((StgMutClosure *)p);
955 /* -----------------------------------------------------------------------------
956 Adding a MUT_CONS to an older generation.
958 This is necessary from time to time when we end up with an
959 old-to-new generation pointer in a non-mutable object. We defer
960 the promotion until the next GC.
961 -------------------------------------------------------------------------- */
964 mkMutCons(StgClosure *ptr, generation *gen)
969 step = &gen->steps[0];
971 /* chain a new block onto the to-space for the destination step if
974 if (step->hp + sizeofW(StgIndOldGen) >= step->hpLim) {
978 q = (StgMutVar *)step->hp;
979 step->hp += sizeofW(StgMutVar);
981 SET_HDR(q,&MUT_CONS_info,CCS_GC);
983 recordOldToNewPtrs((StgMutClosure *)q);
985 return (StgClosure *)q;
988 /* -----------------------------------------------------------------------------
991 This is called (eventually) for every live object in the system.
993 The caller to evacuate specifies a desired generation in the
994 evac_gen global variable. The following conditions apply to
995 evacuating an object which resides in generation M when we're
996 collecting up to generation N
1000 else evac to step->to
1002 if M < evac_gen evac to evac_gen, step 0
1004 if the object is already evacuated, then we check which generation
1007 if M >= evac_gen do nothing
1008 if M < evac_gen set failed_to_evac flag to indicate that we
1009 didn't manage to evacuate this object into evac_gen.
1011 -------------------------------------------------------------------------- */
1015 evacuate(StgClosure *q)
1020 const StgInfoTable *info;
1023 if (!LOOKS_LIKE_STATIC(q)) {
1025 if (bd->gen->no > N) {
1026 /* Can't evacuate this object, because it's in a generation
1027 * older than the ones we're collecting. Let's hope that it's
1028 * in evac_gen or older, or we will have to make an IND_OLDGEN object.
1030 if (bd->gen->no < evac_gen) {
1032 failed_to_evac = rtsTrue;
1033 TICK_GC_FAILED_PROMOTION();
1037 step = bd->step->to;
1040 /* make sure the info pointer is into text space */
1041 ASSERT(q && (LOOKS_LIKE_GHC_INFO(GET_INFO(q))
1042 || IS_HUGS_CONSTR_INFO(GET_INFO(q))));
1045 switch (info -> type) {
1048 to = copy(q,bco_sizeW(stgCast(StgBCO*,q)),step);
1053 ASSERT(q->header.info != &MUT_CONS_info);
1055 to = copy(q,sizeW_fromITBL(info),step);
1057 recordMutable((StgMutClosure *)to);
1061 stable_ptr_table[((StgStableName *)q)->sn].keep = rtsTrue;
1062 to = copy(q,sizeofW(StgStableName),step);
1070 to = copy(q,sizeofW(StgHeader)+1,step);
1074 case THUNK_1_0: /* here because of MIN_UPD_SIZE */
1085 to = copy(q,sizeofW(StgHeader)+2,step);
1093 case IND_OLDGEN_PERM:
1098 to = copy(q,sizeW_fromITBL(info),step);
1104 to = copyPart(q,BLACKHOLE_sizeW(),sizeofW(StgHeader),step);
1109 to = copy(q,BLACKHOLE_sizeW(),step);
1111 recordMutable((StgMutClosure *)to);
1114 case THUNK_SELECTOR:
1116 const StgInfoTable* selectee_info;
1117 StgClosure* selectee = ((StgSelector*)q)->selectee;
1120 selectee_info = get_itbl(selectee);
1121 switch (selectee_info->type) {
1130 StgNat32 offset = info->layout.selector_offset;
1132 /* check that the size is in range */
1134 (StgNat32)(selectee_info->layout.payload.ptrs +
1135 selectee_info->layout.payload.nptrs));
1137 /* perform the selection! */
1138 q = selectee->payload[offset];
1140 /* if we're already in to-space, there's no need to continue
1141 * with the evacuation, just update the source address with
1142 * a pointer to the (evacuated) constructor field.
1144 if (IS_USER_PTR(q)) {
1145 bdescr *bd = Bdescr((P_)q);
1146 if (bd->evacuated) {
1147 if (bd->gen->no < evac_gen) {
1148 failed_to_evac = rtsTrue;
1149 TICK_GC_FAILED_PROMOTION();
1155 /* otherwise, carry on and evacuate this constructor field,
1156 * (but not the constructor itself)
1165 case IND_OLDGEN_PERM:
1166 selectee = stgCast(StgInd *,selectee)->indirectee;
1170 selectee = stgCast(StgCAF *,selectee)->value;
1174 selectee = stgCast(StgEvacuated*,selectee)->evacuee;
1184 case THUNK_SELECTOR:
1185 /* aargh - do recursively???? */
1190 /* not evaluated yet */
1194 barf("evacuate: THUNK_SELECTOR: strange selectee");
1197 to = copy(q,THUNK_SELECTOR_sizeW(),step);
1203 /* follow chains of indirections, don't evacuate them */
1204 q = ((StgInd*)q)->indirectee;
1207 /* ToDo: optimise STATIC_LINK for known cases.
1208 - FUN_STATIC : payload[0]
1209 - THUNK_STATIC : payload[1]
1210 - IND_STATIC : payload[1]
1214 if (info->srt_len == 0) { /* small optimisation */
1220 /* don't want to evacuate these, but we do want to follow pointers
1221 * from SRTs - see scavenge_static.
1224 /* put the object on the static list, if necessary.
1226 if (major_gc && STATIC_LINK(info,(StgClosure *)q) == NULL) {
1227 STATIC_LINK(info,(StgClosure *)q) = static_objects;
1228 static_objects = (StgClosure *)q;
1232 case CONSTR_INTLIKE:
1233 case CONSTR_CHARLIKE:
1234 case CONSTR_NOCAF_STATIC:
1235 /* no need to put these on the static linked list, they don't need
1250 /* shouldn't see these */
1251 barf("evacuate: stack frame\n");
1255 /* these are special - the payload is a copy of a chunk of stack,
1257 to = copy(q,pap_sizeW(stgCast(StgPAP*,q)),step);
1262 /* Already evacuated, just return the forwarding address.
1263 * HOWEVER: if the requested destination generation (evac_gen) is
1264 * older than the actual generation (because the object was
1265 * already evacuated to a younger generation) then we have to
1266 * set the failed_to_evac flag to indicate that we couldn't
1267 * manage to promote the object to the desired generation.
1269 if (evac_gen > 0) { /* optimisation */
1270 StgClosure *p = ((StgEvacuated*)q)->evacuee;
1271 if (Bdescr((P_)p)->gen->no < evac_gen) {
1272 /* fprintf(stderr,"evac failed!\n");*/
1273 failed_to_evac = rtsTrue;
1274 TICK_GC_FAILED_PROMOTION();
1277 return ((StgEvacuated*)q)->evacuee;
1282 nat size = arr_words_sizeW(stgCast(StgArrWords*,q));
1284 if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
1285 evacuate_large((P_)q, rtsFalse);
1288 /* just copy the block */
1289 to = copy(q,size,step);
1296 case MUT_ARR_PTRS_FROZEN:
1298 nat size = mut_arr_ptrs_sizeW(stgCast(StgMutArrPtrs*,q));
1300 if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
1301 evacuate_large((P_)q, info->type == MUT_ARR_PTRS);
1304 /* just copy the block */
1305 to = copy(q,size,step);
1307 if (info->type == MUT_ARR_PTRS) {
1308 recordMutable((StgMutClosure *)to);
1316 StgTSO *tso = stgCast(StgTSO *,q);
1317 nat size = tso_sizeW(tso);
1320 /* Large TSOs don't get moved, so no relocation is required.
1322 if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
1323 evacuate_large((P_)q, rtsTrue);
1326 /* To evacuate a small TSO, we need to relocate the update frame
1330 StgTSO *new_tso = (StgTSO *)copy((StgClosure *)tso,tso_sizeW(tso),step);
1332 diff = (StgPtr)new_tso - (StgPtr)tso; /* In *words* */
1334 /* relocate the stack pointers... */
1335 new_tso->su = (StgUpdateFrame *) ((StgPtr)new_tso->su + diff);
1336 new_tso->sp = (StgPtr)new_tso->sp + diff;
1337 new_tso->splim = (StgPtr)new_tso->splim + diff;
1339 relocate_TSO(tso, new_tso);
1340 upd_evacuee(q,(StgClosure *)new_tso);
1342 recordMutable((StgMutClosure *)new_tso);
1343 return (StgClosure *)new_tso;
1349 fprintf(stderr,"evacuate: unimplemented/strange closure type\n");
1353 barf("evacuate: strange closure type");
1359 /* -----------------------------------------------------------------------------
1360 relocate_TSO is called just after a TSO has been copied from src to
1361 dest. It adjusts the update frame list for the new location.
1362 -------------------------------------------------------------------------- */
1365 relocate_TSO(StgTSO *src, StgTSO *dest)
1372 diff = (StgPtr)dest->sp - (StgPtr)src->sp; /* In *words* */
1376 while ((P_)su < dest->stack + dest->stack_size) {
1377 switch (get_itbl(su)->type) {
1379 /* GCC actually manages to common up these three cases! */
1382 su->link = (StgUpdateFrame *) ((StgPtr)su->link + diff);
1387 cf = (StgCatchFrame *)su;
1388 cf->link = (StgUpdateFrame *) ((StgPtr)cf->link + diff);
1393 sf = (StgSeqFrame *)su;
1394 sf->link = (StgUpdateFrame *) ((StgPtr)sf->link + diff);
1403 barf("relocate_TSO");
1412 scavenge_srt(const StgInfoTable *info)
1414 StgClosure **srt, **srt_end;
1416 /* evacuate the SRT. If srt_len is zero, then there isn't an
1417 * srt field in the info table. That's ok, because we'll
1418 * never dereference it.
1420 srt = stgCast(StgClosure **,info->srt);
1421 srt_end = srt + info->srt_len;
1422 for (; srt < srt_end; srt++) {
1427 /* -----------------------------------------------------------------------------
1428 Scavenge a given step until there are no more objects in this step
1431 evac_gen is set by the caller to be either zero (for a step in a
1432 generation < N) or G where G is the generation of the step being
1435 We sometimes temporarily change evac_gen back to zero if we're
1436 scavenging a mutable object where early promotion isn't such a good
1438 -------------------------------------------------------------------------- */
1442 scavenge(step *step)
1445 const StgInfoTable *info;
1447 nat saved_evac_gen = evac_gen; /* used for temporarily changing evac_gen */
1452 failed_to_evac = rtsFalse;
1454 /* scavenge phase - standard breadth-first scavenging of the
1458 while (bd != step->hp_bd || p < step->hp) {
1460 /* If we're at the end of this block, move on to the next block */
1461 if (bd != step->hp_bd && p == bd->free) {
1467 q = p; /* save ptr to object */
1469 ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO((StgClosure *)p))
1470 || IS_HUGS_CONSTR_INFO(GET_INFO((StgClosure *)p))));
1472 info = get_itbl((StgClosure *)p);
1473 switch (info -> type) {
1477 StgBCO* bco = stgCast(StgBCO*,p);
1479 for (i = 0; i < bco->n_ptrs; i++) {
1480 bcoConstCPtr(bco,i) = evacuate(bcoConstCPtr(bco,i));
1482 p += bco_sizeW(bco);
1487 /* treat MVars specially, because we don't want to evacuate the
1488 * mut_link field in the middle of the closure.
1491 StgMVar *mvar = ((StgMVar *)p);
1493 (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head);
1494 (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail);
1495 (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value);
1496 p += sizeofW(StgMVar);
1497 evac_gen = saved_evac_gen;
1505 ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
1506 ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
1507 p += sizeofW(StgHeader) + 2;
1512 ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
1513 p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */
1519 ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
1520 p += sizeofW(StgHeader) + 1;
1525 p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */
1531 p += sizeofW(StgHeader) + 1;
1538 p += sizeofW(StgHeader) + 2;
1545 ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
1546 p += sizeofW(StgHeader) + 2;
1559 case IND_OLDGEN_PERM:
1565 end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
1566 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
1567 (StgClosure *)*p = evacuate((StgClosure *)*p);
1569 p += info->layout.payload.nptrs;
1574 /* ignore MUT_CONSs */
1575 if (((StgMutVar *)p)->header.info != &MUT_CONS_info) {
1577 ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
1578 evac_gen = saved_evac_gen;
1580 p += sizeofW(StgMutVar);
1585 p += BLACKHOLE_sizeW();
1590 StgBlockingQueue *bh = (StgBlockingQueue *)p;
1591 (StgClosure *)bh->blocking_queue =
1592 evacuate((StgClosure *)bh->blocking_queue);
1593 if (failed_to_evac) {
1594 failed_to_evac = rtsFalse;
1595 recordMutable((StgMutClosure *)bh);
1597 p += BLACKHOLE_sizeW();
1601 case THUNK_SELECTOR:
1603 StgSelector *s = (StgSelector *)p;
1604 s->selectee = evacuate(s->selectee);
1605 p += THUNK_SELECTOR_sizeW();
1611 barf("scavenge:IND???\n");
1613 case CONSTR_INTLIKE:
1614 case CONSTR_CHARLIKE:
1616 case CONSTR_NOCAF_STATIC:
1620 /* Shouldn't see a static object here. */
1621 barf("scavenge: STATIC object\n");
1633 /* Shouldn't see stack frames here. */
1634 barf("scavenge: stack frame\n");
1636 case AP_UPD: /* same as PAPs */
1638 /* Treat a PAP just like a section of stack, not forgetting to
1639 * evacuate the function pointer too...
1642 StgPAP* pap = stgCast(StgPAP*,p);
1644 pap->fun = evacuate(pap->fun);
1645 scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
1646 p += pap_sizeW(pap);
1652 /* nothing to follow */
1653 p += arr_words_sizeW(stgCast(StgArrWords*,p));
1657 /* follow everything */
1661 evac_gen = 0; /* repeatedly mutable */
1662 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1663 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1664 (StgClosure *)*p = evacuate((StgClosure *)*p);
1666 evac_gen = saved_evac_gen;
1670 case MUT_ARR_PTRS_FROZEN:
1671 /* follow everything */
1673 StgPtr start = p, next;
1675 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1676 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
1677 (StgClosure *)*p = evacuate((StgClosure *)*p);
1679 if (failed_to_evac) {
1680 /* we can do this easier... */
1681 recordMutable((StgMutClosure *)start);
1682 failed_to_evac = rtsFalse;
1693 /* chase the link field for any TSOs on the same queue */
1694 (StgClosure *)tso->link = evacuate((StgClosure *)tso->link);
1695 /* scavenge this thread's stack */
1696 scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
1697 evac_gen = saved_evac_gen;
1698 p += tso_sizeW(tso);
1705 barf("scavenge: unimplemented/strange closure type\n");
1711 /* If we didn't manage to promote all the objects pointed to by
1712 * the current object, then we have to designate this object as
1713 * mutable (because it contains old-to-new generation pointers).
1715 if (failed_to_evac) {
1716 mkMutCons((StgClosure *)q, &generations[evac_gen]);
1717 failed_to_evac = rtsFalse;
1725 /* -----------------------------------------------------------------------------
1726 Scavenge one object.
1728 This is used for objects that are temporarily marked as mutable
1729 because they contain old-to-new generation pointers. Only certain
1730 objects can have this property.
1731 -------------------------------------------------------------------------- */
1733 scavenge_one(StgClosure *p)
1738 ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO(p))
1739 || IS_HUGS_CONSTR_INFO(GET_INFO(p))));
1743 switch (info -> type) {
1746 case FUN_1_0: /* hardly worth specialising these guys */
1766 case IND_OLDGEN_PERM:
1772 end = (P_)p->payload + info->layout.payload.ptrs;
1773 for (q = (P_)p->payload; q < end; q++) {
1774 (StgClosure *)*q = evacuate((StgClosure *)*q);
1783 case THUNK_SELECTOR:
1785 StgSelector *s = (StgSelector *)p;
1786 s->selectee = evacuate(s->selectee);
1790 case AP_UPD: /* same as PAPs */
1792 /* Treat a PAP just like a section of stack, not forgetting to
1793 * evacuate the function pointer too...
1796 StgPAP* pap = (StgPAP *)p;
1798 pap->fun = evacuate(pap->fun);
1799 scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
1804 /* This might happen if for instance a MUT_CONS was pointing to a
1805 * THUNK which has since been updated. The IND_OLDGEN will
1806 * be on the mutable list anyway, so we don't need to do anything
1812 barf("scavenge_one: strange object");
1815 no_luck = failed_to_evac;
1816 failed_to_evac = rtsFalse;
1821 /* -----------------------------------------------------------------------------
1822 Scavenging mutable lists.
1824 We treat the mutable list of each generation > N (i.e. all the
1825 generations older than the one being collected) as roots. We also
1826 remove non-mutable objects from the mutable list at this point.
1827 -------------------------------------------------------------------------- */
1830 scavenge_mut_once_list(generation *gen)
1833 StgMutClosure *p, *next, *new_list;
1835 p = gen->mut_once_list;
1836 new_list = END_MUT_LIST;
1840 failed_to_evac = rtsFalse;
1842 for (; p != END_MUT_LIST; p = next, next = p->mut_link) {
1844 /* make sure the info pointer is into text space */
1845 ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO(p))
1846 || IS_HUGS_CONSTR_INFO(GET_INFO(p))));
1849 switch(info->type) {
1852 case IND_OLDGEN_PERM:
1854 /* Try to pull the indirectee into this generation, so we can
1855 * remove the indirection from the mutable list.
1857 ((StgIndOldGen *)p)->indirectee =
1858 evacuate(((StgIndOldGen *)p)->indirectee);
1861 /* Debugging code to print out the size of the thing we just
1865 StgPtr start = gen->steps[0].scan;
1866 bdescr *start_bd = gen->steps[0].scan_bd;
1868 scavenge(&gen->steps[0]);
1869 if (start_bd != gen->steps[0].scan_bd) {
1870 size += (P_)BLOCK_ROUND_UP(start) - start;
1871 start_bd = start_bd->link;
1872 while (start_bd != gen->steps[0].scan_bd) {
1873 size += BLOCK_SIZE_W;
1874 start_bd = start_bd->link;
1876 size += gen->steps[0].scan -
1877 (P_)BLOCK_ROUND_DOWN(gen->steps[0].scan);
1879 size = gen->steps[0].scan - start;
1881 fprintf(stderr,"evac IND_OLDGEN: %d bytes\n", size * sizeof(W_));
1885 /* failed_to_evac might happen if we've got more than two
1886 * generations, we're collecting only generation 0, the
1887 * indirection resides in generation 2 and the indirectee is
1890 if (failed_to_evac) {
1891 failed_to_evac = rtsFalse;
1892 p->mut_link = new_list;
1895 /* the mut_link field of an IND_STATIC is overloaded as the
1896 * static link field too (it just so happens that we don't need
1897 * both at the same time), so we need to NULL it out when
1898 * removing this object from the mutable list because the static
1899 * link fields are all assumed to be NULL before doing a major
1907 /* MUT_CONS is a kind of MUT_VAR, except it that we try to remove
1908 * it from the mutable list if possible by promoting whatever it
1911 ASSERT(p->header.info == &MUT_CONS_info);
1912 if (scavenge_one(((StgMutVar *)p)->var) == rtsTrue) {
1913 /* didn't manage to promote everything, so put the
1914 * MUT_CONS back on the list.
1916 p->mut_link = new_list;
1922 /* shouldn't have anything else on the mutables list */
1923 barf("scavenge_mut_once_list: strange object?");
1927 gen->mut_once_list = new_list;
1932 scavenge_mutable_list(generation *gen)
1935 StgMutClosure *p, *next, *new_list;
1937 p = gen->saved_mut_list;
1938 new_list = END_MUT_LIST;
1942 failed_to_evac = rtsFalse;
1944 for (; p != END_MUT_LIST; p = next, next = p->mut_link) {
1946 /* make sure the info pointer is into text space */
1947 ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO(p))
1948 || IS_HUGS_CONSTR_INFO(GET_INFO(p))));
1951 switch(info->type) {
1953 case MUT_ARR_PTRS_FROZEN:
1954 /* remove this guy from the mutable list, but follow the ptrs
1955 * anyway (and make sure they get promoted to this gen).
1960 end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1962 for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) {
1963 (StgClosure *)*q = evacuate((StgClosure *)*q);
1967 if (failed_to_evac) {
1968 failed_to_evac = rtsFalse;
1969 p->mut_link = new_list;
1976 /* follow everything */
1977 p->mut_link = new_list;
1982 end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1983 for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) {
1984 (StgClosure *)*q = evacuate((StgClosure *)*q);
1990 /* MUT_CONS is a kind of MUT_VAR, except that we try to remove
1991 * it from the mutable list if possible by promoting whatever it
1994 ASSERT(p->header.info != &MUT_CONS_info);
1995 ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
1996 p->mut_link = new_list;
2002 StgMVar *mvar = (StgMVar *)p;
2003 (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head);
2004 (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail);
2005 (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value);
2006 p->mut_link = new_list;
2012 /* follow ptrs and remove this from the mutable list */
2014 StgTSO *tso = (StgTSO *)p;
2016 /* Don't bother scavenging if this thread is dead
2018 if (!(tso->whatNext == ThreadComplete ||
2019 tso->whatNext == ThreadKilled)) {
2020 /* Don't need to chase the link field for any TSOs on the
2021 * same queue. Just scavenge this thread's stack
2023 scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
2026 /* Don't take this TSO off the mutable list - it might still
2027 * point to some younger objects (because we set evac_gen to 0
2030 tso->mut_link = new_list;
2031 new_list = (StgMutClosure *)tso;
2037 StgBlockingQueue *bh = (StgBlockingQueue *)p;
2038 (StgClosure *)bh->blocking_queue =
2039 evacuate((StgClosure *)bh->blocking_queue);
2040 p->mut_link = new_list;
2046 /* shouldn't have anything else on the mutables list */
2047 barf("scavenge_mut_list: strange object?");
2051 gen->mut_list = new_list;
2055 scavenge_static(void)
2057 StgClosure* p = static_objects;
2058 const StgInfoTable *info;
2060 /* Always evacuate straight to the oldest generation for static
2062 evac_gen = oldest_gen->no;
2064 /* keep going until we've scavenged all the objects on the linked
2066 while (p != END_OF_STATIC_LIST) {
2070 /* make sure the info pointer is into text space */
2071 ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO(p))
2072 || IS_HUGS_CONSTR_INFO(GET_INFO(p))));
2074 /* Take this object *off* the static_objects list,
2075 * and put it on the scavenged_static_objects list.
2077 static_objects = STATIC_LINK(info,p);
2078 STATIC_LINK(info,p) = scavenged_static_objects;
2079 scavenged_static_objects = p;
2081 switch (info -> type) {
2085 StgInd *ind = (StgInd *)p;
2086 ind->indirectee = evacuate(ind->indirectee);
2088 /* might fail to evacuate it, in which case we have to pop it
2089 * back on the mutable list (and take it off the
2090 * scavenged_static list because the static link and mut link
2091 * pointers are one and the same).
2093 if (failed_to_evac) {
2094 failed_to_evac = rtsFalse;
2095 scavenged_static_objects = STATIC_LINK(info,p);
2096 ((StgMutClosure *)ind)->mut_link = oldest_gen->mut_once_list;
2097 oldest_gen->mut_once_list = (StgMutClosure *)ind;
2111 next = (P_)p->payload + info->layout.payload.ptrs;
2112 /* evacuate the pointers */
2113 for (q = (P_)p->payload; q < next; q++) {
2114 (StgClosure *)*q = evacuate((StgClosure *)*q);
2120 barf("scavenge_static");
2123 ASSERT(failed_to_evac == rtsFalse);
2125 /* get the next static object from the list. Remeber, there might
2126 * be more stuff on this list now that we've done some evacuating!
2127 * (static_objects is a global)
2133 /* -----------------------------------------------------------------------------
2134 scavenge_stack walks over a section of stack and evacuates all the
2135 objects pointed to by it. We can use the same code for walking
2136 PAPs, since these are just sections of copied stack.
2137 -------------------------------------------------------------------------- */
2140 scavenge_stack(StgPtr p, StgPtr stack_end)
2143 const StgInfoTable* info;
2147 * Each time around this loop, we are looking at a chunk of stack
2148 * that starts with either a pending argument section or an
2149 * activation record.
2152 while (p < stack_end) {
2153 q = *stgCast(StgPtr*,p);
2155 /* If we've got a tag, skip over that many words on the stack */
2156 if (IS_ARG_TAG(stgCast(StgWord,q))) {
2161 /* Is q a pointer to a closure?
2163 if (! LOOKS_LIKE_GHC_INFO(q)) {
2166 if (LOOKS_LIKE_STATIC(q)) { /* Is it a static closure? */
2167 ASSERT(closure_STATIC(stgCast(StgClosure*,q)));
2169 /* otherwise, must be a pointer into the allocation space.
2173 (StgClosure *)*p = evacuate((StgClosure *)q);
2179 * Otherwise, q must be the info pointer of an activation
2180 * record. All activation records have 'bitmap' style layout
2183 info = get_itbl(stgCast(StgClosure*,p));
2185 switch (info->type) {
2187 /* Dynamic bitmap: the mask is stored on the stack */
2189 bitmap = stgCast(StgRetDyn*,p)->liveness;
2190 p = &payloadWord(stgCast(StgRetDyn*,p),0);
2193 /* probably a slow-entry point return address: */
2199 /* Specialised code for update frames, since they're so common.
2200 * We *know* the updatee points to a BLACKHOLE, CAF_BLACKHOLE,
2201 * or BLACKHOLE_BQ, so just inline the code to evacuate it here.
2205 StgUpdateFrame *frame = (StgUpdateFrame *)p;
2207 StgClosureType type = get_itbl(frame->updatee)->type;
2209 p += sizeofW(StgUpdateFrame);
2210 if (type == EVACUATED) {
2211 frame->updatee = evacuate(frame->updatee);
2214 bdescr *bd = Bdescr((P_)frame->updatee);
2216 if (bd->gen->no > N) {
2217 if (bd->gen->no < evac_gen) {
2218 failed_to_evac = rtsTrue;
2222 step = bd->step->to;
2226 to = copyPart(frame->updatee, BLACKHOLE_sizeW(),
2227 sizeofW(StgHeader), step);
2228 upd_evacuee(frame->updatee,to);
2229 frame->updatee = to;
2232 to = copy(frame->updatee, BLACKHOLE_sizeW(), step);
2233 upd_evacuee(frame->updatee,to);
2234 frame->updatee = to;
2235 recordMutable((StgMutClosure *)to);
2238 barf("scavenge_stack: UPDATE_FRAME updatee");
2243 /* small bitmap (< 32 entries, or 64 on a 64-bit machine) */
2250 bitmap = info->layout.bitmap;
2253 while (bitmap != 0) {
2254 if ((bitmap & 1) == 0) {
2255 (StgClosure *)*p = evacuate((StgClosure *)*p);
2258 bitmap = bitmap >> 1;
2265 /* large bitmap (> 32 entries) */
2270 StgLargeBitmap *large_bitmap;
2273 large_bitmap = info->layout.large_bitmap;
2276 for (i=0; i<large_bitmap->size; i++) {
2277 bitmap = large_bitmap->bitmap[i];
2278 q = p + sizeof(W_) * 8;
2279 while (bitmap != 0) {
2280 if ((bitmap & 1) == 0) {
2281 (StgClosure *)*p = evacuate((StgClosure *)*p);
2284 bitmap = bitmap >> 1;
2286 if (i+1 < large_bitmap->size) {
2288 (StgClosure *)*p = evacuate((StgClosure *)*p);
2294 /* and don't forget to follow the SRT */
2299 barf("scavenge_stack: weird activation record found on stack.\n");
2304 /*-----------------------------------------------------------------------------
2305 scavenge the large object list.
2307 evac_gen set by caller; similar games played with evac_gen as with
2308 scavenge() - see comment at the top of scavenge(). Most large
2309 objects are (repeatedly) mutable, so most of the time evac_gen will
2311 --------------------------------------------------------------------------- */
2314 scavenge_large(step *step)
2318 const StgInfoTable* info;
2319 nat saved_evac_gen = evac_gen; /* used for temporarily changing evac_gen */
2321 evac_gen = 0; /* most objects are mutable */
2322 bd = step->new_large_objects;
2324 for (; bd != NULL; bd = step->new_large_objects) {
2326 /* take this object *off* the large objects list and put it on
2327 * the scavenged large objects list. This is so that we can
2328 * treat new_large_objects as a stack and push new objects on
2329 * the front when evacuating.
2331 step->new_large_objects = bd->link;
2332 dbl_link_onto(bd, &step->scavenged_large_objects);
2335 info = get_itbl(stgCast(StgClosure*,p));
2337 switch (info->type) {
2339 /* only certain objects can be "large"... */
2343 /* nothing to follow */
2347 /* follow everything */
2351 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
2352 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
2353 (StgClosure *)*p = evacuate((StgClosure *)*p);
2358 case MUT_ARR_PTRS_FROZEN:
2359 /* follow everything */
2361 StgPtr start = p, next;
2363 evac_gen = saved_evac_gen; /* not really mutable */
2364 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
2365 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
2366 (StgClosure *)*p = evacuate((StgClosure *)*p);
2369 if (failed_to_evac) {
2370 recordMutable((StgMutClosure *)start);
2377 StgBCO* bco = stgCast(StgBCO*,p);
2379 evac_gen = saved_evac_gen;
2380 for (i = 0; i < bco->n_ptrs; i++) {
2381 bcoConstCPtr(bco,i) = evacuate(bcoConstCPtr(bco,i));
2392 /* chase the link field for any TSOs on the same queue */
2393 (StgClosure *)tso->link = evacuate((StgClosure *)tso->link);
2394 /* scavenge this thread's stack */
2395 scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
2400 barf("scavenge_large: unknown/strange object");
2406 zeroStaticObjectList(StgClosure* first_static)
2410 const StgInfoTable *info;
2412 for (p = first_static; p != END_OF_STATIC_LIST; p = link) {
2414 link = STATIC_LINK(info, p);
2415 STATIC_LINK(info,p) = NULL;
2419 /* This function is only needed because we share the mutable link
2420 * field with the static link field in an IND_STATIC, so we have to
2421 * zero the mut_link field before doing a major GC, which needs the
2422 * static link field.
2424 * It doesn't do any harm to zero all the mutable link fields on the
2428 zeroMutableList(StgMutClosure *first)
2430 StgMutClosure *next, *c;
2432 for (c = first; c != END_MUT_LIST; c = next) {
2438 /* -----------------------------------------------------------------------------
2440 -------------------------------------------------------------------------- */
2442 void RevertCAFs(void)
2444 while (enteredCAFs != END_CAF_LIST) {
2445 StgCAF* caf = enteredCAFs;
2447 enteredCAFs = caf->link;
2448 ASSERT(get_itbl(caf)->type == CAF_ENTERED);
2449 SET_INFO(caf,&CAF_UNENTERED_info);
2450 caf->value = stgCast(StgClosure*,0xdeadbeef);
2451 caf->link = stgCast(StgCAF*,0xdeadbeef);
2455 void revertDeadCAFs(void)
2457 StgCAF* caf = enteredCAFs;
2458 enteredCAFs = END_CAF_LIST;
2459 while (caf != END_CAF_LIST) {
2460 StgCAF* next = caf->link;
2462 switch(GET_INFO(caf)->type) {
2465 /* This object has been evacuated, it must be live. */
2466 StgCAF* new = stgCast(StgCAF*,stgCast(StgEvacuated*,caf)->evacuee);
2467 new->link = enteredCAFs;
2473 SET_INFO(caf,&CAF_UNENTERED_info);
2474 caf->value = stgCast(StgClosure*,0xdeadbeef);
2475 caf->link = stgCast(StgCAF*,0xdeadbeef);
2479 barf("revertDeadCAFs: enteredCAFs list corrupted");
2485 /* -----------------------------------------------------------------------------
2486 Sanity code for CAF garbage collection.
2488 With DEBUG turned on, we manage a CAF list in addition to the SRT
2489 mechanism. After GC, we run down the CAF list and blackhole any
2490 CAFs which have been garbage collected. This means we get an error
2491 whenever the program tries to enter a garbage collected CAF.
2493 Any garbage collected CAFs are taken off the CAF list at the same
2495 -------------------------------------------------------------------------- */
2503 const StgInfoTable *info;
2514 ASSERT(info->type == IND_STATIC);
2516 if (STATIC_LINK(info,p) == NULL) {
2517 IF_DEBUG(gccafs, fprintf(stderr, "CAF gc'd at 0x%04x\n", (int)p));
2519 SET_INFO(p,&BLACKHOLE_info);
2520 p = STATIC_LINK2(info,p);
2524 pp = &STATIC_LINK2(info,p);
2531 /* fprintf(stderr, "%d CAFs live\n", i); */
2535 /* -----------------------------------------------------------------------------
2538 Whenever a thread returns to the scheduler after possibly doing
2539 some work, we have to run down the stack and black-hole all the
2540 closures referred to by update frames.
2541 -------------------------------------------------------------------------- */
2544 threadLazyBlackHole(StgTSO *tso)
2546 StgUpdateFrame *update_frame;
2547 StgBlockingQueue *bh;
2550 stack_end = &tso->stack[tso->stack_size];
2551 update_frame = tso->su;
2554 switch (get_itbl(update_frame)->type) {
2557 update_frame = stgCast(StgCatchFrame*,update_frame)->link;
2561 bh = (StgBlockingQueue *)update_frame->updatee;
2563 /* if the thunk is already blackholed, it means we've also
2564 * already blackholed the rest of the thunks on this stack,
2565 * so we can stop early.
2567 * The blackhole made for a CAF is a CAF_BLACKHOLE, so they
2568 * don't interfere with this optimisation.
2570 if (bh->header.info == &BLACKHOLE_info) {
2574 if (bh->header.info != &BLACKHOLE_BQ_info &&
2575 bh->header.info != &CAF_BLACKHOLE_info) {
2576 SET_INFO(bh,&BLACKHOLE_info);
2579 update_frame = update_frame->link;
2583 update_frame = stgCast(StgSeqFrame*,update_frame)->link;
2589 barf("threadPaused");
2594 /* -----------------------------------------------------------------------------
2597 * Code largely pinched from old RTS, then hacked to bits. We also do
2598 * lazy black holing here.
2600 * -------------------------------------------------------------------------- */
2603 threadSqueezeStack(StgTSO *tso)
2605 lnat displacement = 0;
2606 StgUpdateFrame *frame;
2607 StgUpdateFrame *next_frame; /* Temporally next */
2608 StgUpdateFrame *prev_frame; /* Temporally previous */
2610 rtsBool prev_was_update_frame;
2612 bottom = &(tso->stack[tso->stack_size]);
2615 /* There must be at least one frame, namely the STOP_FRAME.
2617 ASSERT((P_)frame < bottom);
2619 /* Walk down the stack, reversing the links between frames so that
2620 * we can walk back up as we squeeze from the bottom. Note that
2621 * next_frame and prev_frame refer to next and previous as they were
2622 * added to the stack, rather than the way we see them in this
2623 * walk. (It makes the next loop less confusing.)
2625 * Stop if we find an update frame pointing to a black hole
2626 * (see comment in threadLazyBlackHole()).
2630 while ((P_)frame < bottom - 1) { /* bottom - 1 is the STOP_FRAME */
2631 prev_frame = frame->link;
2632 frame->link = next_frame;
2635 if (get_itbl(frame)->type == UPDATE_FRAME
2636 && frame->updatee->header.info == &BLACKHOLE_info) {
2641 /* Now, we're at the bottom. Frame points to the lowest update
2642 * frame on the stack, and its link actually points to the frame
2643 * above. We have to walk back up the stack, squeezing out empty
2644 * update frames and turning the pointers back around on the way
2647 * The bottom-most frame (the STOP_FRAME) has not been altered, and
2648 * we never want to eliminate it anyway. Just walk one step up
2649 * before starting to squeeze. When you get to the topmost frame,
2650 * remember that there are still some words above it that might have
2657 prev_was_update_frame = (get_itbl(prev_frame)->type == UPDATE_FRAME);
2660 * Loop through all of the frames (everything except the very
2661 * bottom). Things are complicated by the fact that we have
2662 * CATCH_FRAMEs and SEQ_FRAMEs interspersed with the update frames.
2663 * We can only squeeze when there are two consecutive UPDATE_FRAMEs.
2665 while (frame != NULL) {
2667 StgPtr frame_bottom = (P_)frame + sizeofW(StgUpdateFrame);
2668 rtsBool is_update_frame;
2670 next_frame = frame->link;
2671 is_update_frame = (get_itbl(frame)->type == UPDATE_FRAME);
2674 * 1. both the previous and current frame are update frames
2675 * 2. the current frame is empty
2677 if (prev_was_update_frame && is_update_frame &&
2678 (P_)prev_frame == frame_bottom + displacement) {
2680 /* Now squeeze out the current frame */
2681 StgClosure *updatee_keep = prev_frame->updatee;
2682 StgClosure *updatee_bypass = frame->updatee;
2685 fprintf(stderr, "squeezing frame at %p\n", frame);
2688 /* Deal with blocking queues. If both updatees have blocked
2689 * threads, then we should merge the queues into the update
2690 * frame that we're keeping.
2692 * Alternatively, we could just wake them up: they'll just go
2693 * straight to sleep on the proper blackhole! This is less code
2694 * and probably less bug prone, although it's probably much
2697 #if 0 /* do it properly... */
2698 if (GET_INFO(updatee_bypass) == BLACKHOLE_BQ_info) {
2699 /* Sigh. It has one. Don't lose those threads! */
2700 if (GET_INFO(updatee_keep) == BLACKHOLE_BQ_info) {
2701 /* Urgh. Two queues. Merge them. */
2702 P_ keep_tso = ((StgBlockingQueue *)updatee_keep)->blocking_queue;
2704 while (keep_tso->link != END_TSO_QUEUE) {
2705 keep_tso = keep_tso->link;
2707 keep_tso->link = ((StgBlockingQueue *)updatee_bypass)->blocking_queue;
2710 /* For simplicity, just swap the BQ for the BH */
2711 P_ temp = updatee_keep;
2713 updatee_keep = updatee_bypass;
2714 updatee_bypass = temp;
2716 /* Record the swap in the kept frame (below) */
2717 prev_frame->updatee = updatee_keep;
2722 TICK_UPD_SQUEEZED();
2723 UPD_IND(updatee_bypass, updatee_keep); /* this wakes the threads up */
2725 sp = (P_)frame - 1; /* sp = stuff to slide */
2726 displacement += sizeofW(StgUpdateFrame);
2729 /* No squeeze for this frame */
2730 sp = frame_bottom - 1; /* Keep the current frame */
2732 /* Do lazy black-holing.
2734 if (is_update_frame) {
2735 StgBlockingQueue *bh = (StgBlockingQueue *)frame->updatee;
2736 if (bh->header.info != &BLACKHOLE_BQ_info &&
2737 bh->header.info != &CAF_BLACKHOLE_info) {
2738 SET_INFO(bh,&BLACKHOLE_info);
2742 /* Fix the link in the current frame (should point to the frame below) */
2743 frame->link = prev_frame;
2744 prev_was_update_frame = is_update_frame;
2747 /* Now slide all words from sp up to the next frame */
2749 if (displacement > 0) {
2750 P_ next_frame_bottom;
2752 if (next_frame != NULL)
2753 next_frame_bottom = (P_)next_frame + sizeofW(StgUpdateFrame);
2755 next_frame_bottom = tso->sp - 1;
2758 fprintf(stderr, "sliding [%p, %p] by %ld\n", sp, next_frame_bottom,
2762 while (sp >= next_frame_bottom) {
2763 sp[displacement] = *sp;
2767 (P_)prev_frame = (P_)frame + displacement;
2771 tso->sp += displacement;
2772 tso->su = prev_frame;
2775 /* -----------------------------------------------------------------------------
2778 * We have to prepare for GC - this means doing lazy black holing
2779 * here. We also take the opportunity to do stack squeezing if it's
2781 * -------------------------------------------------------------------------- */
2784 threadPaused(StgTSO *tso)
2786 if ( RtsFlags.GcFlags.squeezeUpdFrames == rtsTrue )
2787 threadSqueezeStack(tso); /* does black holing too */
2789 threadLazyBlackHole(tso);