1 /* -----------------------------------------------------------------------------
2 * $Id: GC.c,v 1.31 1999/02/15 14:27:19 simonm Exp $
4 * (c) The GHC Team 1998-1999
6 * Generational garbage collector
8 * ---------------------------------------------------------------------------*/
14 #include "StoragePriv.h"
17 #include "SchedAPI.h" /* for ReverCAFs prototype */
20 #include "BlockAlloc.h"
22 #include "DebugProf.h"
25 #include "StablePriv.h"
29 /* STATIC OBJECT LIST.
32 * We maintain a linked list of static objects that are still live.
33 * The requirements for this list are:
35 * - we need to scan the list while adding to it, in order to
36 * scavenge all the static objects (in the same way that
37 * breadth-first scavenging works for dynamic objects).
39 * - we need to be able to tell whether an object is already on
40 * the list, to break loops.
42 * Each static object has a "static link field", which we use for
43 * linking objects on to the list. We use a stack-type list, consing
44 * objects on the front as they are added (this means that the
45 * scavenge phase is depth-first, not breadth-first, but that
48 * A separate list is kept for objects that have been scavenged
49 * already - this is so that we can zero all the marks afterwards.
51 * An object is on the list if its static link field is non-zero; this
52 * means that we have to mark the end of the list with '1', not NULL.
54 * Extra notes for generational GC:
56 * Each generation has a static object list associated with it. When
57 * collecting generations up to N, we treat the static object lists
58 * from generations > N as roots.
60 * We build up a static object list while collecting generations 0..N,
61 * which is then appended to the static object list of generation N+1.
63 StgClosure* static_objects; /* live static objects */
64 StgClosure* scavenged_static_objects; /* static objects scavenged so far */
66 /* N is the oldest generation being collected, where the generations
67 * are numbered starting at 0. A major GC (indicated by the major_gc
68 * flag) is when we're collecting all generations. We only attempt to
69 * deal with static objects and GC CAFs when doing a major GC.
72 static rtsBool major_gc;
74 /* Youngest generation that objects should be evacuated to in
75 * evacuate(). (Logically an argument to evacuate, but it's static
76 * a lot of the time so we optimise it into a global variable).
82 static StgWeak *old_weak_ptr_list; /* also pending finaliser list */
83 static rtsBool weak_done; /* all done for this pass */
85 /* Flag indicating failure to evacuate an object to the desired
88 static rtsBool failed_to_evac;
90 /* Old to-space (used for two-space collector only)
94 /* -----------------------------------------------------------------------------
95 Static function declarations
96 -------------------------------------------------------------------------- */
98 static StgClosure *evacuate(StgClosure *q);
99 static void zeroStaticObjectList(StgClosure* first_static);
100 static rtsBool traverse_weak_ptr_list(void);
101 static void zeroMutableList(StgMutClosure *first);
102 static void revertDeadCAFs(void);
104 static void scavenge_stack(StgPtr p, StgPtr stack_end);
105 static void scavenge_large(step *step);
106 static void scavenge(step *step);
107 static void scavenge_static(void);
108 static void scavenge_mutable_list(generation *g);
109 static void scavenge_mut_once_list(generation *g);
112 static void gcCAFs(void);
115 /* -----------------------------------------------------------------------------
118 For garbage collecting generation N (and all younger generations):
120 - follow all pointers in the root set. the root set includes all
121 mutable objects in all steps in all generations.
123 - for each pointer, evacuate the object it points to into either
124 + to-space in the next higher step in that generation, if one exists,
125 + if the object's generation == N, then evacuate it to the next
126 generation if one exists, or else to-space in the current
128 + if the object's generation < N, then evacuate it to to-space
129 in the next generation.
131 - repeatedly scavenge to-space from each step in each generation
132 being collected until no more objects can be evacuated.
134 - free from-space in each step, and set from-space = to-space.
136 -------------------------------------------------------------------------- */
138 void GarbageCollect(void (*get_roots)(void))
142 lnat live, allocated, collected = 0;
146 CostCentreStack *prev_CCS;
149 /* tell the stats department that we've started a GC */
152 /* attribute any costs to CCS_GC */
158 /* We might have been called from Haskell land by _ccall_GC, in
159 * which case we need to call threadPaused() because the scheduler
160 * won't have done it.
162 if (CurrentTSO) { threadPaused(CurrentTSO); }
164 /* Approximate how much we allocated: number of blocks in the
165 * nursery + blocks allocated via allocate() - unused nusery blocks.
166 * This leaves a little slop at the end of each block, and doesn't
167 * take into account large objects (ToDo).
169 allocated = (nursery_blocks * BLOCK_SIZE_W) + allocated_bytes();
170 for ( bd = current_nursery->link; bd != NULL; bd = bd->link ) {
171 allocated -= BLOCK_SIZE_W;
174 /* Figure out which generation to collect
177 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
178 if (generations[g].steps[0].n_blocks >= generations[g].max_blocks) {
182 major_gc = (N == RtsFlags.GcFlags.generations-1);
184 /* check stack sanity *before* GC (ToDo: check all threads) */
185 /*IF_DEBUG(sanity, checkTSO(MainTSO,0)); */
186 IF_DEBUG(sanity, checkFreeListSanity());
188 /* Initialise the static object lists
190 static_objects = END_OF_STATIC_LIST;
191 scavenged_static_objects = END_OF_STATIC_LIST;
193 /* zero the mutable list for the oldest generation (see comment by
194 * zeroMutableList below).
197 zeroMutableList(generations[RtsFlags.GcFlags.generations-1].mut_once_list);
200 /* Save the old to-space if we're doing a two-space collection
202 if (RtsFlags.GcFlags.generations == 1) {
203 old_to_space = g0s0->to_space;
204 g0s0->to_space = NULL;
207 /* Initialise to-space in all the generations/steps that we're
210 for (g = 0; g <= N; g++) {
211 generations[g].mut_once_list = END_MUT_LIST;
212 generations[g].mut_list = END_MUT_LIST;
214 for (s = 0; s < generations[g].n_steps; s++) {
216 /* generation 0, step 0 doesn't need to-space */
217 if (g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1) {
221 /* Get a free block for to-space. Extra blocks will be chained on
225 step = &generations[g].steps[s];
226 ASSERT(step->gen->no == g);
227 ASSERT(step->hp ? Bdescr(step->hp)->step == step : rtsTrue);
228 bd->gen = &generations[g];
231 bd->evacuated = 1; /* it's a to-space block */
232 step->hp = bd->start;
233 step->hpLim = step->hp + BLOCK_SIZE_W;
236 step->to_blocks = 1; /* ???? */
237 step->scan = bd->start;
239 step->new_large_objects = NULL;
240 step->scavenged_large_objects = NULL;
241 /* mark the large objects as not evacuated yet */
242 for (bd = step->large_objects; bd; bd = bd->link) {
248 /* make sure the older generations have at least one block to
249 * allocate into (this makes things easier for copy(), see below.
251 for (g = N+1; g < RtsFlags.GcFlags.generations; g++) {
252 for (s = 0; s < generations[g].n_steps; s++) {
253 step = &generations[g].steps[s];
254 if (step->hp_bd == NULL) {
256 bd->gen = &generations[g];
259 bd->evacuated = 0; /* *not* a to-space block */
260 step->hp = bd->start;
261 step->hpLim = step->hp + BLOCK_SIZE_W;
266 /* Set the scan pointer for older generations: remember we
267 * still have to scavenge objects that have been promoted. */
268 step->scan = step->hp;
269 step->scan_bd = step->hp_bd;
270 step->to_space = NULL;
272 step->new_large_objects = NULL;
273 step->scavenged_large_objects = NULL;
277 /* -----------------------------------------------------------------------
278 * follow all the roots that we know about:
279 * - mutable lists from each generation > N
280 * we want to *scavenge* these roots, not evacuate them: they're not
281 * going to move in this GC.
282 * Also: do them in reverse generation order. This is because we
283 * often want to promote objects that are pointed to by older
284 * generations early, so we don't have to repeatedly copy them.
285 * Doing the generations in reverse order ensures that we don't end
286 * up in the situation where we want to evac an object to gen 3 and
287 * it has already been evaced to gen 2.
291 for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
292 generations[g].saved_mut_list = generations[g].mut_list;
293 generations[g].mut_list = END_MUT_LIST;
296 /* Do the mut-once lists first */
297 for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
298 scavenge_mut_once_list(&generations[g]);
300 for (st = generations[g].n_steps-1; st >= 0; st--) {
301 scavenge(&generations[g].steps[st]);
305 for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
306 scavenge_mutable_list(&generations[g]);
308 for (st = generations[g].n_steps-1; st >= 0; st--) {
309 scavenge(&generations[g].steps[st]);
314 /* follow all the roots that the application knows about.
319 /* And don't forget to mark the TSO if we got here direct from
322 CurrentTSO = (StgTSO *)MarkRoot((StgClosure *)CurrentTSO);
325 /* Mark the weak pointer list, and prepare to detect dead weak
329 old_weak_ptr_list = weak_ptr_list;
330 weak_ptr_list = NULL;
331 weak_done = rtsFalse;
333 /* Mark the stable pointer table.
335 markStablePtrTable(major_gc);
339 /* ToDo: To fix the caf leak, we need to make the commented out
340 * parts of this code do something sensible - as described in
343 extern void markHugsObjects(void);
345 /* ToDo: This (undefined) function should contain the scavenge
346 * loop immediately below this block of code - but I'm not sure
347 * enough of the details to do this myself.
349 scavengeEverything();
350 /* revert dead CAFs and update enteredCAFs list */
355 /* This will keep the CAFs and the attached BCOs alive
356 * but the values will have been reverted
358 scavengeEverything();
363 /* -------------------------------------------------------------------------
364 * Repeatedly scavenge all the areas we know about until there's no
365 * more scavenging to be done.
372 /* scavenge static objects */
373 if (major_gc && static_objects != END_OF_STATIC_LIST) {
377 /* When scavenging the older generations: Objects may have been
378 * evacuated from generations <= N into older generations, and we
379 * need to scavenge these objects. We're going to try to ensure that
380 * any evacuations that occur move the objects into at least the
381 * same generation as the object being scavenged, otherwise we
382 * have to create new entries on the mutable list for the older
386 /* scavenge each step in generations 0..maxgen */
390 for (gen = RtsFlags.GcFlags.generations-1; gen >= 0; gen--) {
391 for (st = generations[gen].n_steps-1; st >= 0 ; st--) {
392 step = &generations[gen].steps[st];
394 if (step->hp_bd != step->scan_bd || step->scan < step->hp) {
399 if (step->new_large_objects != NULL) {
400 scavenge_large(step);
407 if (flag) { goto loop; }
409 /* must be last... */
410 if (traverse_weak_ptr_list()) { /* returns rtsTrue if evaced something */
415 /* Now see which stable names are still alive
417 gcStablePtrTable(major_gc);
419 /* Set the maximum blocks for the oldest generation, based on twice
420 * the amount of live data now, adjusted to fit the maximum heap
423 * This is an approximation, since in the worst case we'll need
424 * twice the amount of live data plus whatever space the other
427 if (RtsFlags.GcFlags.generations > 1) {
429 oldest_gen->max_blocks =
430 stg_max(oldest_gen->steps[0].to_blocks * RtsFlags.GcFlags.oldGenFactor,
431 RtsFlags.GcFlags.minOldGenSize);
432 if (oldest_gen->max_blocks > RtsFlags.GcFlags.maxHeapSize / 2) {
433 oldest_gen->max_blocks = RtsFlags.GcFlags.maxHeapSize / 2;
434 if (((int)oldest_gen->max_blocks -
435 (int)oldest_gen->steps[0].to_blocks) <
436 (RtsFlags.GcFlags.pcFreeHeap *
437 RtsFlags.GcFlags.maxHeapSize / 200)) {
444 /* run through all the generations/steps and tidy up
446 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
449 generations[g].collections++; /* for stats */
452 for (s = 0; s < generations[g].n_steps; s++) {
454 step = &generations[g].steps[s];
456 if (!(g == 0 && s == 0 && RtsFlags.GcFlags.generations > 1)) {
457 /* Tidy the end of the to-space chains */
458 step->hp_bd->free = step->hp;
459 step->hp_bd->link = NULL;
462 /* for generations we collected... */
465 collected += step->n_blocks * BLOCK_SIZE_W; /* for stats */
467 /* free old memory and shift to-space into from-space for all
468 * the collected steps (except the allocation area). These
469 * freed blocks will probaby be quickly recycled.
471 if (!(g == 0 && s == 0)) {
472 freeChain(step->blocks);
473 step->blocks = step->to_space;
474 step->n_blocks = step->to_blocks;
475 step->to_space = NULL;
477 for (bd = step->blocks; bd != NULL; bd = bd->link) {
478 bd->evacuated = 0; /* now from-space */
482 /* LARGE OBJECTS. The current live large objects are chained on
483 * scavenged_large, having been moved during garbage
484 * collection from large_objects. Any objects left on
485 * large_objects list are therefore dead, so we free them here.
487 for (bd = step->large_objects; bd != NULL; bd = next) {
492 for (bd = step->scavenged_large_objects; bd != NULL; bd = bd->link) {
495 step->large_objects = step->scavenged_large_objects;
497 /* Set the maximum blocks for this generation, interpolating
498 * between the maximum size of the oldest and youngest
501 * max_blocks = oldgen_max_blocks * G
502 * ----------------------
506 generations[g].max_blocks = (oldest_gen->max_blocks * g)
507 / (RtsFlags.GcFlags.generations-1);
510 /* for older generations... */
513 /* For older generations, we need to append the
514 * scavenged_large_object list (i.e. large objects that have been
515 * promoted during this GC) to the large_object list for that step.
517 for (bd = step->scavenged_large_objects; bd; bd = next) {
520 dbl_link_onto(bd, &step->large_objects);
523 /* add the new blocks we promoted during this GC */
524 step->n_blocks += step->to_blocks;
529 /* Guess the amount of live data for stats. */
532 /* Two-space collector:
533 * Free the old to-space, and estimate the amount of live data.
535 if (RtsFlags.GcFlags.generations == 1) {
538 if (old_to_space != NULL) {
539 freeChain(old_to_space);
541 for (bd = g0s0->to_space; bd != NULL; bd = bd->link) {
542 bd->evacuated = 0; /* now from-space */
545 /* For a two-space collector, we need to resize the nursery. */
547 /* set up a new nursery. Allocate a nursery size based on a
548 * function of the amount of live data (currently a factor of 2,
549 * should be configurable (ToDo)). Use the blocks from the old
550 * nursery if possible, freeing up any left over blocks.
552 * If we get near the maximum heap size, then adjust our nursery
553 * size accordingly. If the nursery is the same size as the live
554 * data (L), then we need 3L bytes. We can reduce the size of the
555 * nursery to bring the required memory down near 2L bytes.
557 * A normal 2-space collector would need 4L bytes to give the same
558 * performance we get from 3L bytes, reducing to the same
559 * performance at 2L bytes.
561 blocks = g0s0->to_blocks;
563 if ( blocks * RtsFlags.GcFlags.oldGenFactor * 2 >
564 RtsFlags.GcFlags.maxHeapSize ) {
565 int adjusted_blocks; /* signed on purpose */
568 adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);
569 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));
570 pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize;
571 if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even be < 0 */ {
574 blocks = adjusted_blocks;
577 blocks *= RtsFlags.GcFlags.oldGenFactor;
578 if (blocks < RtsFlags.GcFlags.minAllocAreaSize) {
579 blocks = RtsFlags.GcFlags.minAllocAreaSize;
582 resizeNursery(blocks);
585 /* Generational collector:
586 * If the user has given us a suggested heap size, adjust our
587 * allocation area to make best use of the memory available.
590 if (RtsFlags.GcFlags.heapSizeSuggestion) {
592 nat needed = calcNeeded(); /* approx blocks needed at next GC */
594 /* Guess how much will be live in generation 0 step 0 next time.
595 * A good approximation is the amount of data that was live this
596 * time: this assumes (1) that the size of G0S0 will be roughly
597 * the same as last time, and (2) that the promotion rate will be
600 * If we don't know how much was live in G0S0 (because there's no
601 * step 1), then assume 30% (which is usually an overestimate).
603 if (g0->n_steps == 1) {
604 needed += (g0s0->n_blocks * 30) / 100;
606 needed += g0->steps[1].n_blocks;
609 /* Now we have a rough guess at the number of blocks needed for
610 * the next GC, subtract this from the user's suggested heap size
611 * and use the rest for the allocation area.
613 blocks = (int)RtsFlags.GcFlags.heapSizeSuggestion - (int)needed;
615 if (blocks < (int)RtsFlags.GcFlags.minAllocAreaSize) {
616 blocks = RtsFlags.GcFlags.minAllocAreaSize;
619 resizeNursery((nat)blocks);
623 /* revert dead CAFs and update enteredCAFs list */
626 /* mark the garbage collected CAFs as dead */
628 if (major_gc) { gcCAFs(); }
631 /* zero the scavenged static object list */
633 zeroStaticObjectList(scavenged_static_objects);
638 for (bd = g0s0->blocks; bd; bd = bd->link) {
639 bd->free = bd->start;
640 ASSERT(bd->gen == g0);
641 ASSERT(bd->step == g0s0);
643 current_nursery = g0s0->blocks;
645 /* Free the small objects allocated via allocate(), since this will
646 * all have been copied into G0S1 now.
648 if (small_alloc_list != NULL) {
649 freeChain(small_alloc_list);
651 small_alloc_list = NULL;
653 alloc_blocks_lim = RtsFlags.GcFlags.minAllocAreaSize;
655 /* start any pending finalizers */
656 scheduleFinalizers(old_weak_ptr_list);
658 /* check sanity after GC */
659 IF_DEBUG(sanity, checkSanity(N));
661 /* extra GC trace info */
662 IF_DEBUG(gc, stat_describe_gens());
665 /* symbol-table based profiling */
666 /* heapCensus(to_space); */ /* ToDo */
669 /* restore enclosing cost centre */
674 /* check for memory leaks if sanity checking is on */
675 IF_DEBUG(sanity, memInventory());
677 /* ok, GC over: tell the stats department what happened. */
678 stat_endGC(allocated, collected, live, N);
681 /* -----------------------------------------------------------------------------
684 traverse_weak_ptr_list is called possibly many times during garbage
685 collection. It returns a flag indicating whether it did any work
686 (i.e. called evacuate on any live pointers).
688 Invariant: traverse_weak_ptr_list is called when the heap is in an
689 idempotent state. That means that there are no pending
690 evacuate/scavenge operations. This invariant helps the weak
691 pointer code decide which weak pointers are dead - if there are no
692 new live weak pointers, then all the currently unreachable ones are
695 For generational GC: we just don't try to finalize weak pointers in
696 older generations than the one we're collecting. This could
697 probably be optimised by keeping per-generation lists of weak
698 pointers, but for a few weak pointers this scheme will work.
699 -------------------------------------------------------------------------- */
702 traverse_weak_ptr_list(void)
704 StgWeak *w, **last_w, *next_w;
706 rtsBool flag = rtsFalse;
708 if (weak_done) { return rtsFalse; }
710 /* doesn't matter where we evacuate values/finalizers to, since
711 * these pointers are treated as roots (iff the keys are alive).
715 last_w = &old_weak_ptr_list;
716 for (w = old_weak_ptr_list; w; w = next_w) {
718 if ((new = isAlive(w->key))) {
720 /* evacuate the value and finalizer */
721 w->value = evacuate(w->value);
722 w->finalizer = evacuate(w->finalizer);
723 /* remove this weak ptr from the old_weak_ptr list */
725 /* and put it on the new weak ptr list */
727 w->link = weak_ptr_list;
730 IF_DEBUG(weak, fprintf(stderr,"Weak pointer still alive at %p -> %p\n", w, w->key));
740 /* If we didn't make any changes, then we can go round and kill all
741 * the dead weak pointers. The old_weak_ptr list is used as a list
742 * of pending finalizers later on.
744 if (flag == rtsFalse) {
745 for (w = old_weak_ptr_list; w; w = w->link) {
746 w->value = evacuate(w->value);
747 w->finalizer = evacuate(w->finalizer);
755 /* -----------------------------------------------------------------------------
756 isAlive determines whether the given closure is still alive (after
757 a garbage collection) or not. It returns the new address of the
758 closure if it is alive, or NULL otherwise.
759 -------------------------------------------------------------------------- */
762 isAlive(StgClosure *p)
770 /* ToDo: for static closures, check the static link field.
771 * Problem here is that we sometimes don't set the link field, eg.
772 * for static closures with an empty SRT or CONSTR_STATIC_NOCAFs.
775 /* ignore closures in generations that we're not collecting. */
776 if (LOOKS_LIKE_STATIC(p) || Bdescr((P_)p)->gen->no > N) {
780 switch (info->type) {
785 case IND_OLDGEN: /* rely on compatible layout with StgInd */
786 case IND_OLDGEN_PERM:
787 /* follow indirections */
788 p = ((StgInd *)p)->indirectee;
793 return ((StgEvacuated *)p)->evacuee;
803 MarkRoot(StgClosure *root)
805 return evacuate(root);
808 static void addBlock(step *step)
810 bdescr *bd = allocBlock();
814 if (step->gen->no <= N) {
820 step->hp_bd->free = step->hp;
821 step->hp_bd->link = bd;
822 step->hp = bd->start;
823 step->hpLim = step->hp + BLOCK_SIZE_W;
828 static __inline__ StgClosure *
829 copy(StgClosure *src, nat size, step *step)
833 TICK_GC_WORDS_COPIED(size);
834 /* Find out where we're going, using the handy "to" pointer in
835 * the step of the source object. If it turns out we need to
836 * evacuate to an older generation, adjust it here (see comment
839 if (step->gen->no < evac_gen) {
840 step = &generations[evac_gen].steps[0];
843 /* chain a new block onto the to-space for the destination step if
846 if (step->hp + size >= step->hpLim) {
850 for(to = step->hp, from = (P_)src; size>0; --size) {
856 return (StgClosure *)dest;
859 /* Special version of copy() for when we only want to copy the info
860 * pointer of an object, but reserve some padding after it. This is
861 * used to optimise evacuation of BLACKHOLEs.
864 static __inline__ StgClosure *
865 copyPart(StgClosure *src, nat size_to_reserve, nat size_to_copy, step *step)
869 TICK_GC_WORDS_COPIED(size_to_copy);
870 if (step->gen->no < evac_gen) {
871 step = &generations[evac_gen].steps[0];
874 if (step->hp + size_to_reserve >= step->hpLim) {
878 for(to = step->hp, from = (P_)src; size_to_copy>0; --size_to_copy) {
883 step->hp += size_to_reserve;
884 return (StgClosure *)dest;
887 static __inline__ void
888 upd_evacuee(StgClosure *p, StgClosure *dest)
890 StgEvacuated *q = (StgEvacuated *)p;
892 SET_INFO(q,&EVACUATED_info);
896 /* -----------------------------------------------------------------------------
897 Evacuate a large object
899 This just consists of removing the object from the (doubly-linked)
900 large_alloc_list, and linking it on to the (singly-linked)
901 new_large_objects list, from where it will be scavenged later.
903 Convention: bd->evacuated is /= 0 for a large object that has been
904 evacuated, or 0 otherwise.
905 -------------------------------------------------------------------------- */
908 evacuate_large(StgPtr p, rtsBool mutable)
910 bdescr *bd = Bdescr(p);
913 /* should point to the beginning of the block */
914 ASSERT(((W_)p & BLOCK_MASK) == 0);
916 /* already evacuated? */
918 /* Don't forget to set the failed_to_evac flag if we didn't get
919 * the desired destination (see comments in evacuate()).
921 if (bd->gen->no < evac_gen) {
922 failed_to_evac = rtsTrue;
923 TICK_GC_FAILED_PROMOTION();
929 /* remove from large_object list */
931 bd->back->link = bd->link;
932 } else { /* first object in the list */
933 step->large_objects = bd->link;
936 bd->link->back = bd->back;
939 /* link it on to the evacuated large object list of the destination step
942 if (step->gen->no < evac_gen) {
943 step = &generations[evac_gen].steps[0];
948 bd->link = step->new_large_objects;
949 step->new_large_objects = bd;
953 recordMutable((StgMutClosure *)p);
957 /* -----------------------------------------------------------------------------
958 Adding a MUT_CONS to an older generation.
960 This is necessary from time to time when we end up with an
961 old-to-new generation pointer in a non-mutable object. We defer
962 the promotion until the next GC.
963 -------------------------------------------------------------------------- */
966 mkMutCons(StgClosure *ptr, generation *gen)
971 step = &gen->steps[0];
973 /* chain a new block onto the to-space for the destination step if
976 if (step->hp + sizeofW(StgIndOldGen) >= step->hpLim) {
980 q = (StgMutVar *)step->hp;
981 step->hp += sizeofW(StgMutVar);
983 SET_HDR(q,&MUT_CONS_info,CCS_GC);
985 recordOldToNewPtrs((StgMutClosure *)q);
987 return (StgClosure *)q;
990 /* -----------------------------------------------------------------------------
993 This is called (eventually) for every live object in the system.
995 The caller to evacuate specifies a desired generation in the
996 evac_gen global variable. The following conditions apply to
997 evacuating an object which resides in generation M when we're
998 collecting up to generation N
1002 else evac to step->to
1004 if M < evac_gen evac to evac_gen, step 0
1006 if the object is already evacuated, then we check which generation
1009 if M >= evac_gen do nothing
1010 if M < evac_gen set failed_to_evac flag to indicate that we
1011 didn't manage to evacuate this object into evac_gen.
1013 -------------------------------------------------------------------------- */
1017 evacuate(StgClosure *q)
1022 const StgInfoTable *info;
1025 if (!LOOKS_LIKE_STATIC(q)) {
1027 if (bd->gen->no > N) {
1028 /* Can't evacuate this object, because it's in a generation
1029 * older than the ones we're collecting. Let's hope that it's
1030 * in evac_gen or older, or we will have to make an IND_OLDGEN object.
1032 if (bd->gen->no < evac_gen) {
1034 failed_to_evac = rtsTrue;
1035 TICK_GC_FAILED_PROMOTION();
1039 step = bd->step->to;
1042 /* make sure the info pointer is into text space */
1043 ASSERT(q && (LOOKS_LIKE_GHC_INFO(GET_INFO(q))
1044 || IS_HUGS_CONSTR_INFO(GET_INFO(q))));
1047 switch (info -> type) {
1050 to = copy(q,bco_sizeW(stgCast(StgBCO*,q)),step);
1055 ASSERT(q->header.info != &MUT_CONS_info);
1057 to = copy(q,sizeW_fromITBL(info),step);
1059 recordMutable((StgMutClosure *)to);
1063 stable_ptr_table[((StgStableName *)q)->sn].keep = rtsTrue;
1064 to = copy(q,sizeofW(StgStableName),step);
1072 to = copy(q,sizeofW(StgHeader)+1,step);
1076 case THUNK_1_0: /* here because of MIN_UPD_SIZE */
1087 to = copy(q,sizeofW(StgHeader)+2,step);
1095 case IND_OLDGEN_PERM:
1100 to = copy(q,sizeW_fromITBL(info),step);
1106 to = copyPart(q,BLACKHOLE_sizeW(),sizeofW(StgHeader),step);
1111 to = copy(q,BLACKHOLE_sizeW(),step);
1113 recordMutable((StgMutClosure *)to);
1116 case THUNK_SELECTOR:
1118 const StgInfoTable* selectee_info;
1119 StgClosure* selectee = ((StgSelector*)q)->selectee;
1122 selectee_info = get_itbl(selectee);
1123 switch (selectee_info->type) {
1132 StgNat32 offset = info->layout.selector_offset;
1134 /* check that the size is in range */
1136 (StgNat32)(selectee_info->layout.payload.ptrs +
1137 selectee_info->layout.payload.nptrs));
1139 /* perform the selection! */
1140 q = selectee->payload[offset];
1142 /* if we're already in to-space, there's no need to continue
1143 * with the evacuation, just update the source address with
1144 * a pointer to the (evacuated) constructor field.
1146 if (IS_USER_PTR(q)) {
1147 bdescr *bd = Bdescr((P_)q);
1148 if (bd->evacuated) {
1149 if (bd->gen->no < evac_gen) {
1150 failed_to_evac = rtsTrue;
1151 TICK_GC_FAILED_PROMOTION();
1157 /* otherwise, carry on and evacuate this constructor field,
1158 * (but not the constructor itself)
1167 case IND_OLDGEN_PERM:
1168 selectee = stgCast(StgInd *,selectee)->indirectee;
1172 selectee = stgCast(StgCAF *,selectee)->value;
1176 selectee = stgCast(StgEvacuated*,selectee)->evacuee;
1186 case THUNK_SELECTOR:
1187 /* aargh - do recursively???? */
1192 /* not evaluated yet */
1196 barf("evacuate: THUNK_SELECTOR: strange selectee");
1199 to = copy(q,THUNK_SELECTOR_sizeW(),step);
1205 /* follow chains of indirections, don't evacuate them */
1206 q = ((StgInd*)q)->indirectee;
1209 /* ToDo: optimise STATIC_LINK for known cases.
1210 - FUN_STATIC : payload[0]
1211 - THUNK_STATIC : payload[1]
1212 - IND_STATIC : payload[1]
1216 if (info->srt_len == 0) { /* small optimisation */
1222 /* don't want to evacuate these, but we do want to follow pointers
1223 * from SRTs - see scavenge_static.
1226 /* put the object on the static list, if necessary.
1228 if (major_gc && STATIC_LINK(info,(StgClosure *)q) == NULL) {
1229 STATIC_LINK(info,(StgClosure *)q) = static_objects;
1230 static_objects = (StgClosure *)q;
1234 case CONSTR_INTLIKE:
1235 case CONSTR_CHARLIKE:
1236 case CONSTR_NOCAF_STATIC:
1237 /* no need to put these on the static linked list, they don't need
1252 /* shouldn't see these */
1253 barf("evacuate: stack frame\n");
1257 /* these are special - the payload is a copy of a chunk of stack,
1259 to = copy(q,pap_sizeW(stgCast(StgPAP*,q)),step);
1264 /* Already evacuated, just return the forwarding address.
1265 * HOWEVER: if the requested destination generation (evac_gen) is
1266 * older than the actual generation (because the object was
1267 * already evacuated to a younger generation) then we have to
1268 * set the failed_to_evac flag to indicate that we couldn't
1269 * manage to promote the object to the desired generation.
1271 if (evac_gen > 0) { /* optimisation */
1272 StgClosure *p = ((StgEvacuated*)q)->evacuee;
1273 if (Bdescr((P_)p)->gen->no < evac_gen) {
1274 /* fprintf(stderr,"evac failed!\n");*/
1275 failed_to_evac = rtsTrue;
1276 TICK_GC_FAILED_PROMOTION();
1279 return ((StgEvacuated*)q)->evacuee;
1283 nat size = arr_words_sizeW(stgCast(StgArrWords*,q));
1285 if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
1286 evacuate_large((P_)q, rtsFalse);
1289 /* just copy the block */
1290 to = copy(q,size,step);
1297 case MUT_ARR_PTRS_FROZEN:
1299 nat size = mut_arr_ptrs_sizeW(stgCast(StgMutArrPtrs*,q));
1301 if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
1302 evacuate_large((P_)q, info->type == MUT_ARR_PTRS);
1305 /* just copy the block */
1306 to = copy(q,size,step);
1308 if (info->type == MUT_ARR_PTRS) {
1309 recordMutable((StgMutClosure *)to);
1317 StgTSO *tso = stgCast(StgTSO *,q);
1318 nat size = tso_sizeW(tso);
1321 /* Large TSOs don't get moved, so no relocation is required.
1323 if (size >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
1324 evacuate_large((P_)q, rtsTrue);
1327 /* To evacuate a small TSO, we need to relocate the update frame
1331 StgTSO *new_tso = (StgTSO *)copy((StgClosure *)tso,tso_sizeW(tso),step);
1333 diff = (StgPtr)new_tso - (StgPtr)tso; /* In *words* */
1335 /* relocate the stack pointers... */
1336 new_tso->su = (StgUpdateFrame *) ((StgPtr)new_tso->su + diff);
1337 new_tso->sp = (StgPtr)new_tso->sp + diff;
1338 new_tso->splim = (StgPtr)new_tso->splim + diff;
1340 relocate_TSO(tso, new_tso);
1341 upd_evacuee(q,(StgClosure *)new_tso);
1343 recordMutable((StgMutClosure *)new_tso);
1344 return (StgClosure *)new_tso;
1350 fprintf(stderr,"evacuate: unimplemented/strange closure type\n");
1354 barf("evacuate: strange closure type");
1360 /* -----------------------------------------------------------------------------
1361 relocate_TSO is called just after a TSO has been copied from src to
1362 dest. It adjusts the update frame list for the new location.
1363 -------------------------------------------------------------------------- */
1366 relocate_TSO(StgTSO *src, StgTSO *dest)
1373 diff = (StgPtr)dest->sp - (StgPtr)src->sp; /* In *words* */
1377 while ((P_)su < dest->stack + dest->stack_size) {
1378 switch (get_itbl(su)->type) {
1380 /* GCC actually manages to common up these three cases! */
1383 su->link = (StgUpdateFrame *) ((StgPtr)su->link + diff);
1388 cf = (StgCatchFrame *)su;
1389 cf->link = (StgUpdateFrame *) ((StgPtr)cf->link + diff);
1394 sf = (StgSeqFrame *)su;
1395 sf->link = (StgUpdateFrame *) ((StgPtr)sf->link + diff);
1404 barf("relocate_TSO");
1413 scavenge_srt(const StgInfoTable *info)
1415 StgClosure **srt, **srt_end;
1417 /* evacuate the SRT. If srt_len is zero, then there isn't an
1418 * srt field in the info table. That's ok, because we'll
1419 * never dereference it.
1421 srt = stgCast(StgClosure **,info->srt);
1422 srt_end = srt + info->srt_len;
1423 for (; srt < srt_end; srt++) {
1428 /* -----------------------------------------------------------------------------
1429 Scavenge a given step until there are no more objects in this step
1432 evac_gen is set by the caller to be either zero (for a step in a
1433 generation < N) or G where G is the generation of the step being
1436 We sometimes temporarily change evac_gen back to zero if we're
1437 scavenging a mutable object where early promotion isn't such a good
1439 -------------------------------------------------------------------------- */
1443 scavenge(step *step)
1446 const StgInfoTable *info;
1448 nat saved_evac_gen = evac_gen; /* used for temporarily changing evac_gen */
1453 failed_to_evac = rtsFalse;
1455 /* scavenge phase - standard breadth-first scavenging of the
1459 while (bd != step->hp_bd || p < step->hp) {
1461 /* If we're at the end of this block, move on to the next block */
1462 if (bd != step->hp_bd && p == bd->free) {
1468 q = p; /* save ptr to object */
1470 ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO((StgClosure *)p))
1471 || IS_HUGS_CONSTR_INFO(GET_INFO((StgClosure *)p))));
1473 info = get_itbl((StgClosure *)p);
1474 switch (info -> type) {
1478 StgBCO* bco = stgCast(StgBCO*,p);
1480 for (i = 0; i < bco->n_ptrs; i++) {
1481 bcoConstCPtr(bco,i) = evacuate(bcoConstCPtr(bco,i));
1483 p += bco_sizeW(bco);
1488 /* treat MVars specially, because we don't want to evacuate the
1489 * mut_link field in the middle of the closure.
1492 StgMVar *mvar = ((StgMVar *)p);
1494 (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head);
1495 (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail);
1496 (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value);
1497 p += sizeofW(StgMVar);
1498 evac_gen = saved_evac_gen;
1506 ((StgClosure *)p)->payload[1] = evacuate(((StgClosure *)p)->payload[1]);
1507 ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
1508 p += sizeofW(StgHeader) + 2;
1513 ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
1514 p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */
1520 ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
1521 p += sizeofW(StgHeader) + 1;
1526 p += sizeofW(StgHeader) + 2; /* MIN_UPD_SIZE */
1532 p += sizeofW(StgHeader) + 1;
1539 p += sizeofW(StgHeader) + 2;
1546 ((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
1547 p += sizeofW(StgHeader) + 2;
1560 case IND_OLDGEN_PERM:
1566 end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
1567 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
1568 (StgClosure *)*p = evacuate((StgClosure *)*p);
1570 p += info->layout.payload.nptrs;
1575 /* ignore MUT_CONSs */
1576 if (((StgMutVar *)p)->header.info != &MUT_CONS_info) {
1578 ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
1579 evac_gen = saved_evac_gen;
1581 p += sizeofW(StgMutVar);
1586 p += BLACKHOLE_sizeW();
1591 StgBlockingQueue *bh = (StgBlockingQueue *)p;
1592 (StgClosure *)bh->blocking_queue =
1593 evacuate((StgClosure *)bh->blocking_queue);
1594 if (failed_to_evac) {
1595 failed_to_evac = rtsFalse;
1596 recordMutable((StgMutClosure *)bh);
1598 p += BLACKHOLE_sizeW();
1602 case THUNK_SELECTOR:
1604 StgSelector *s = (StgSelector *)p;
1605 s->selectee = evacuate(s->selectee);
1606 p += THUNK_SELECTOR_sizeW();
1612 barf("scavenge:IND???\n");
1614 case CONSTR_INTLIKE:
1615 case CONSTR_CHARLIKE:
1617 case CONSTR_NOCAF_STATIC:
1621 /* Shouldn't see a static object here. */
1622 barf("scavenge: STATIC object\n");
1634 /* Shouldn't see stack frames here. */
1635 barf("scavenge: stack frame\n");
1637 case AP_UPD: /* same as PAPs */
1639 /* Treat a PAP just like a section of stack, not forgetting to
1640 * evacuate the function pointer too...
1643 StgPAP* pap = stgCast(StgPAP*,p);
1645 pap->fun = evacuate(pap->fun);
1646 scavenge_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
1647 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;
1937 p = gen->saved_mut_list;
1941 failed_to_evac = rtsFalse;
1943 for (; p != END_MUT_LIST; p = next, next = p->mut_link) {
1945 /* make sure the info pointer is into text space */
1946 ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO(p))
1947 || IS_HUGS_CONSTR_INFO(GET_INFO(p))));
1950 switch(info->type) {
1952 case MUT_ARR_PTRS_FROZEN:
1953 /* remove this guy from the mutable list, but follow the ptrs
1954 * anyway (and make sure they get promoted to this gen).
1959 end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1961 for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) {
1962 (StgClosure *)*q = evacuate((StgClosure *)*q);
1966 if (failed_to_evac) {
1967 failed_to_evac = rtsFalse;
1968 p->mut_link = gen->mut_list;
1975 /* follow everything */
1976 p->mut_link = gen->mut_list;
1981 end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
1982 for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) {
1983 (StgClosure *)*q = evacuate((StgClosure *)*q);
1989 /* MUT_CONS is a kind of MUT_VAR, except that we try to remove
1990 * it from the mutable list if possible by promoting whatever it
1993 ASSERT(p->header.info != &MUT_CONS_info);
1994 ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
1995 p->mut_link = gen->mut_list;
2001 StgMVar *mvar = (StgMVar *)p;
2002 (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head);
2003 (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail);
2004 (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value);
2005 p->mut_link = gen->mut_list;
2011 /* follow ptrs and remove this from the mutable list */
2013 StgTSO *tso = (StgTSO *)p;
2015 /* Don't bother scavenging if this thread is dead
2017 if (!(tso->whatNext == ThreadComplete ||
2018 tso->whatNext == ThreadKilled)) {
2019 /* Don't need to chase the link field for any TSOs on the
2020 * same queue. Just scavenge this thread's stack
2022 scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
2025 /* Don't take this TSO off the mutable list - it might still
2026 * point to some younger objects (because we set evac_gen to 0
2029 tso->mut_link = gen->mut_list;
2030 gen->mut_list = (StgMutClosure *)tso;
2036 StgBlockingQueue *bh = (StgBlockingQueue *)p;
2037 (StgClosure *)bh->blocking_queue =
2038 evacuate((StgClosure *)bh->blocking_queue);
2039 p->mut_link = gen->mut_list;
2045 /* shouldn't have anything else on the mutables list */
2046 barf("scavenge_mut_list: strange object?");
2052 scavenge_static(void)
2054 StgClosure* p = static_objects;
2055 const StgInfoTable *info;
2057 /* Always evacuate straight to the oldest generation for static
2059 evac_gen = oldest_gen->no;
2061 /* keep going until we've scavenged all the objects on the linked
2063 while (p != END_OF_STATIC_LIST) {
2067 /* make sure the info pointer is into text space */
2068 ASSERT(p && (LOOKS_LIKE_GHC_INFO(GET_INFO(p))
2069 || IS_HUGS_CONSTR_INFO(GET_INFO(p))));
2071 /* Take this object *off* the static_objects list,
2072 * and put it on the scavenged_static_objects list.
2074 static_objects = STATIC_LINK(info,p);
2075 STATIC_LINK(info,p) = scavenged_static_objects;
2076 scavenged_static_objects = p;
2078 switch (info -> type) {
2082 StgInd *ind = (StgInd *)p;
2083 ind->indirectee = evacuate(ind->indirectee);
2085 /* might fail to evacuate it, in which case we have to pop it
2086 * back on the mutable list (and take it off the
2087 * scavenged_static list because the static link and mut link
2088 * pointers are one and the same).
2090 if (failed_to_evac) {
2091 failed_to_evac = rtsFalse;
2092 scavenged_static_objects = STATIC_LINK(info,p);
2093 ((StgMutClosure *)ind)->mut_link = oldest_gen->mut_once_list;
2094 oldest_gen->mut_once_list = (StgMutClosure *)ind;
2108 next = (P_)p->payload + info->layout.payload.ptrs;
2109 /* evacuate the pointers */
2110 for (q = (P_)p->payload; q < next; q++) {
2111 (StgClosure *)*q = evacuate((StgClosure *)*q);
2117 barf("scavenge_static");
2120 ASSERT(failed_to_evac == rtsFalse);
2122 /* get the next static object from the list. Remeber, there might
2123 * be more stuff on this list now that we've done some evacuating!
2124 * (static_objects is a global)
2130 /* -----------------------------------------------------------------------------
2131 scavenge_stack walks over a section of stack and evacuates all the
2132 objects pointed to by it. We can use the same code for walking
2133 PAPs, since these are just sections of copied stack.
2134 -------------------------------------------------------------------------- */
2137 scavenge_stack(StgPtr p, StgPtr stack_end)
2140 const StgInfoTable* info;
2144 * Each time around this loop, we are looking at a chunk of stack
2145 * that starts with either a pending argument section or an
2146 * activation record.
2149 while (p < stack_end) {
2150 q = *stgCast(StgPtr*,p);
2152 /* If we've got a tag, skip over that many words on the stack */
2153 if (IS_ARG_TAG(stgCast(StgWord,q))) {
2158 /* Is q a pointer to a closure?
2160 if (! LOOKS_LIKE_GHC_INFO(q)) {
2163 if (LOOKS_LIKE_STATIC(q)) { /* Is it a static closure? */
2164 ASSERT(closure_STATIC(stgCast(StgClosure*,q)));
2166 /* otherwise, must be a pointer into the allocation space.
2170 (StgClosure *)*p = evacuate((StgClosure *)q);
2176 * Otherwise, q must be the info pointer of an activation
2177 * record. All activation records have 'bitmap' style layout
2180 info = get_itbl(stgCast(StgClosure*,p));
2182 switch (info->type) {
2184 /* Dynamic bitmap: the mask is stored on the stack */
2186 bitmap = stgCast(StgRetDyn*,p)->liveness;
2187 p = &payloadWord(stgCast(StgRetDyn*,p),0);
2190 /* probably a slow-entry point return address: */
2196 /* Specialised code for update frames, since they're so common.
2197 * We *know* the updatee points to a BLACKHOLE, CAF_BLACKHOLE,
2198 * or BLACKHOLE_BQ, so just inline the code to evacuate it here.
2202 StgUpdateFrame *frame = (StgUpdateFrame *)p;
2204 StgClosureType type = get_itbl(frame->updatee)->type;
2206 p += sizeofW(StgUpdateFrame);
2207 if (type == EVACUATED) {
2208 frame->updatee = evacuate(frame->updatee);
2211 bdescr *bd = Bdescr((P_)frame->updatee);
2213 if (bd->gen->no > N) {
2214 if (bd->gen->no < evac_gen) {
2215 failed_to_evac = rtsTrue;
2219 step = bd->step->to;
2223 to = copyPart(frame->updatee, BLACKHOLE_sizeW(),
2224 sizeofW(StgHeader), step);
2225 upd_evacuee(frame->updatee,to);
2226 frame->updatee = to;
2229 to = copy(frame->updatee, BLACKHOLE_sizeW(), step);
2230 upd_evacuee(frame->updatee,to);
2231 frame->updatee = to;
2232 recordMutable((StgMutClosure *)to);
2235 barf("scavenge_stack: UPDATE_FRAME updatee");
2240 /* small bitmap (< 32 entries, or 64 on a 64-bit machine) */
2247 bitmap = info->layout.bitmap;
2250 while (bitmap != 0) {
2251 if ((bitmap & 1) == 0) {
2252 (StgClosure *)*p = evacuate((StgClosure *)*p);
2255 bitmap = bitmap >> 1;
2262 /* large bitmap (> 32 entries) */
2267 StgLargeBitmap *large_bitmap;
2270 large_bitmap = info->layout.large_bitmap;
2273 for (i=0; i<large_bitmap->size; i++) {
2274 bitmap = large_bitmap->bitmap[i];
2275 q = p + sizeof(W_) * 8;
2276 while (bitmap != 0) {
2277 if ((bitmap & 1) == 0) {
2278 (StgClosure *)*p = evacuate((StgClosure *)*p);
2281 bitmap = bitmap >> 1;
2283 if (i+1 < large_bitmap->size) {
2285 (StgClosure *)*p = evacuate((StgClosure *)*p);
2291 /* and don't forget to follow the SRT */
2296 barf("scavenge_stack: weird activation record found on stack.\n");
2301 /*-----------------------------------------------------------------------------
2302 scavenge the large object list.
2304 evac_gen set by caller; similar games played with evac_gen as with
2305 scavenge() - see comment at the top of scavenge(). Most large
2306 objects are (repeatedly) mutable, so most of the time evac_gen will
2308 --------------------------------------------------------------------------- */
2311 scavenge_large(step *step)
2315 const StgInfoTable* info;
2316 nat saved_evac_gen = evac_gen; /* used for temporarily changing evac_gen */
2318 evac_gen = 0; /* most objects are mutable */
2319 bd = step->new_large_objects;
2321 for (; bd != NULL; bd = step->new_large_objects) {
2323 /* take this object *off* the large objects list and put it on
2324 * the scavenged large objects list. This is so that we can
2325 * treat new_large_objects as a stack and push new objects on
2326 * the front when evacuating.
2328 step->new_large_objects = bd->link;
2329 dbl_link_onto(bd, &step->scavenged_large_objects);
2332 info = get_itbl(stgCast(StgClosure*,p));
2334 switch (info->type) {
2336 /* only certain objects can be "large"... */
2339 /* nothing to follow */
2343 /* follow everything */
2347 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
2348 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
2349 (StgClosure *)*p = evacuate((StgClosure *)*p);
2354 case MUT_ARR_PTRS_FROZEN:
2355 /* follow everything */
2357 StgPtr start = p, next;
2359 evac_gen = saved_evac_gen; /* not really mutable */
2360 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
2361 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
2362 (StgClosure *)*p = evacuate((StgClosure *)*p);
2365 if (failed_to_evac) {
2366 recordMutable((StgMutClosure *)start);
2373 StgBCO* bco = stgCast(StgBCO*,p);
2375 evac_gen = saved_evac_gen;
2376 for (i = 0; i < bco->n_ptrs; i++) {
2377 bcoConstCPtr(bco,i) = evacuate(bcoConstCPtr(bco,i));
2388 /* chase the link field for any TSOs on the same queue */
2389 (StgClosure *)tso->link = evacuate((StgClosure *)tso->link);
2390 /* scavenge this thread's stack */
2391 scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
2396 barf("scavenge_large: unknown/strange object");
2402 zeroStaticObjectList(StgClosure* first_static)
2406 const StgInfoTable *info;
2408 for (p = first_static; p != END_OF_STATIC_LIST; p = link) {
2410 link = STATIC_LINK(info, p);
2411 STATIC_LINK(info,p) = NULL;
2415 /* This function is only needed because we share the mutable link
2416 * field with the static link field in an IND_STATIC, so we have to
2417 * zero the mut_link field before doing a major GC, which needs the
2418 * static link field.
2420 * It doesn't do any harm to zero all the mutable link fields on the
2424 zeroMutableList(StgMutClosure *first)
2426 StgMutClosure *next, *c;
2428 for (c = first; c != END_MUT_LIST; c = next) {
2434 /* -----------------------------------------------------------------------------
2436 -------------------------------------------------------------------------- */
2438 void RevertCAFs(void)
2440 while (enteredCAFs != END_CAF_LIST) {
2441 StgCAF* caf = enteredCAFs;
2443 enteredCAFs = caf->link;
2444 ASSERT(get_itbl(caf)->type == CAF_ENTERED);
2445 SET_INFO(caf,&CAF_UNENTERED_info);
2446 caf->value = stgCast(StgClosure*,0xdeadbeef);
2447 caf->link = stgCast(StgCAF*,0xdeadbeef);
2451 void revertDeadCAFs(void)
2453 StgCAF* caf = enteredCAFs;
2454 enteredCAFs = END_CAF_LIST;
2455 while (caf != END_CAF_LIST) {
2456 StgCAF* next = caf->link;
2458 switch(GET_INFO(caf)->type) {
2461 /* This object has been evacuated, it must be live. */
2462 StgCAF* new = stgCast(StgCAF*,stgCast(StgEvacuated*,caf)->evacuee);
2463 new->link = enteredCAFs;
2469 SET_INFO(caf,&CAF_UNENTERED_info);
2470 caf->value = stgCast(StgClosure*,0xdeadbeef);
2471 caf->link = stgCast(StgCAF*,0xdeadbeef);
2475 barf("revertDeadCAFs: enteredCAFs list corrupted");
2481 /* -----------------------------------------------------------------------------
2482 Sanity code for CAF garbage collection.
2484 With DEBUG turned on, we manage a CAF list in addition to the SRT
2485 mechanism. After GC, we run down the CAF list and blackhole any
2486 CAFs which have been garbage collected. This means we get an error
2487 whenever the program tries to enter a garbage collected CAF.
2489 Any garbage collected CAFs are taken off the CAF list at the same
2491 -------------------------------------------------------------------------- */
2499 const StgInfoTable *info;
2510 ASSERT(info->type == IND_STATIC);
2512 if (STATIC_LINK(info,p) == NULL) {
2513 IF_DEBUG(gccafs, fprintf(stderr, "CAF gc'd at 0x%04x\n", (int)p));
2515 SET_INFO(p,&BLACKHOLE_info);
2516 p = STATIC_LINK2(info,p);
2520 pp = &STATIC_LINK2(info,p);
2527 /* fprintf(stderr, "%d CAFs live\n", i); */
2531 /* -----------------------------------------------------------------------------
2534 Whenever a thread returns to the scheduler after possibly doing
2535 some work, we have to run down the stack and black-hole all the
2536 closures referred to by update frames.
2537 -------------------------------------------------------------------------- */
2540 threadLazyBlackHole(StgTSO *tso)
2542 StgUpdateFrame *update_frame;
2543 StgBlockingQueue *bh;
2546 stack_end = &tso->stack[tso->stack_size];
2547 update_frame = tso->su;
2550 switch (get_itbl(update_frame)->type) {
2553 update_frame = stgCast(StgCatchFrame*,update_frame)->link;
2557 bh = (StgBlockingQueue *)update_frame->updatee;
2559 /* if the thunk is already blackholed, it means we've also
2560 * already blackholed the rest of the thunks on this stack,
2561 * so we can stop early.
2563 * The blackhole made for a CAF is a CAF_BLACKHOLE, so they
2564 * don't interfere with this optimisation.
2566 if (bh->header.info == &BLACKHOLE_info) {
2570 if (bh->header.info != &BLACKHOLE_BQ_info &&
2571 bh->header.info != &CAF_BLACKHOLE_info) {
2572 SET_INFO(bh,&BLACKHOLE_info);
2575 update_frame = update_frame->link;
2579 update_frame = stgCast(StgSeqFrame*,update_frame)->link;
2585 barf("threadPaused");
2590 /* -----------------------------------------------------------------------------
2593 * Code largely pinched from old RTS, then hacked to bits. We also do
2594 * lazy black holing here.
2596 * -------------------------------------------------------------------------- */
2599 threadSqueezeStack(StgTSO *tso)
2601 lnat displacement = 0;
2602 StgUpdateFrame *frame;
2603 StgUpdateFrame *next_frame; /* Temporally next */
2604 StgUpdateFrame *prev_frame; /* Temporally previous */
2606 rtsBool prev_was_update_frame;
2608 bottom = &(tso->stack[tso->stack_size]);
2611 /* There must be at least one frame, namely the STOP_FRAME.
2613 ASSERT((P_)frame < bottom);
2615 /* Walk down the stack, reversing the links between frames so that
2616 * we can walk back up as we squeeze from the bottom. Note that
2617 * next_frame and prev_frame refer to next and previous as they were
2618 * added to the stack, rather than the way we see them in this
2619 * walk. (It makes the next loop less confusing.)
2621 * Stop if we find an update frame pointing to a black hole
2622 * (see comment in threadLazyBlackHole()).
2626 while ((P_)frame < bottom - 1) { /* bottom - 1 is the STOP_FRAME */
2627 prev_frame = frame->link;
2628 frame->link = next_frame;
2631 if (get_itbl(frame)->type == UPDATE_FRAME
2632 && frame->updatee->header.info == &BLACKHOLE_info) {
2637 /* Now, we're at the bottom. Frame points to the lowest update
2638 * frame on the stack, and its link actually points to the frame
2639 * above. We have to walk back up the stack, squeezing out empty
2640 * update frames and turning the pointers back around on the way
2643 * The bottom-most frame (the STOP_FRAME) has not been altered, and
2644 * we never want to eliminate it anyway. Just walk one step up
2645 * before starting to squeeze. When you get to the topmost frame,
2646 * remember that there are still some words above it that might have
2653 prev_was_update_frame = (get_itbl(prev_frame)->type == UPDATE_FRAME);
2656 * Loop through all of the frames (everything except the very
2657 * bottom). Things are complicated by the fact that we have
2658 * CATCH_FRAMEs and SEQ_FRAMEs interspersed with the update frames.
2659 * We can only squeeze when there are two consecutive UPDATE_FRAMEs.
2661 while (frame != NULL) {
2663 StgPtr frame_bottom = (P_)frame + sizeofW(StgUpdateFrame);
2664 rtsBool is_update_frame;
2666 next_frame = frame->link;
2667 is_update_frame = (get_itbl(frame)->type == UPDATE_FRAME);
2670 * 1. both the previous and current frame are update frames
2671 * 2. the current frame is empty
2673 if (prev_was_update_frame && is_update_frame &&
2674 (P_)prev_frame == frame_bottom + displacement) {
2676 /* Now squeeze out the current frame */
2677 StgClosure *updatee_keep = prev_frame->updatee;
2678 StgClosure *updatee_bypass = frame->updatee;
2681 fprintf(stderr, "squeezing frame at %p\n", frame);
2684 /* Deal with blocking queues. If both updatees have blocked
2685 * threads, then we should merge the queues into the update
2686 * frame that we're keeping.
2688 * Alternatively, we could just wake them up: they'll just go
2689 * straight to sleep on the proper blackhole! This is less code
2690 * and probably less bug prone, although it's probably much
2693 #if 0 /* do it properly... */
2694 if (GET_INFO(updatee_bypass) == BLACKHOLE_BQ_info) {
2695 /* Sigh. It has one. Don't lose those threads! */
2696 if (GET_INFO(updatee_keep) == BLACKHOLE_BQ_info) {
2697 /* Urgh. Two queues. Merge them. */
2698 P_ keep_tso = ((StgBlockingQueue *)updatee_keep)->blocking_queue;
2700 while (keep_tso->link != END_TSO_QUEUE) {
2701 keep_tso = keep_tso->link;
2703 keep_tso->link = ((StgBlockingQueue *)updatee_bypass)->blocking_queue;
2706 /* For simplicity, just swap the BQ for the BH */
2707 P_ temp = updatee_keep;
2709 updatee_keep = updatee_bypass;
2710 updatee_bypass = temp;
2712 /* Record the swap in the kept frame (below) */
2713 prev_frame->updatee = updatee_keep;
2718 TICK_UPD_SQUEEZED();
2719 UPD_IND(updatee_bypass, updatee_keep); /* this wakes the threads up */
2721 sp = (P_)frame - 1; /* sp = stuff to slide */
2722 displacement += sizeofW(StgUpdateFrame);
2725 /* No squeeze for this frame */
2726 sp = frame_bottom - 1; /* Keep the current frame */
2728 /* Do lazy black-holing.
2730 if (is_update_frame) {
2731 StgBlockingQueue *bh = (StgBlockingQueue *)frame->updatee;
2732 if (bh->header.info != &BLACKHOLE_BQ_info &&
2733 bh->header.info != &CAF_BLACKHOLE_info) {
2734 SET_INFO(bh,&BLACKHOLE_info);
2738 /* Fix the link in the current frame (should point to the frame below) */
2739 frame->link = prev_frame;
2740 prev_was_update_frame = is_update_frame;
2743 /* Now slide all words from sp up to the next frame */
2745 if (displacement > 0) {
2746 P_ next_frame_bottom;
2748 if (next_frame != NULL)
2749 next_frame_bottom = (P_)next_frame + sizeofW(StgUpdateFrame);
2751 next_frame_bottom = tso->sp - 1;
2754 fprintf(stderr, "sliding [%p, %p] by %ld\n", sp, next_frame_bottom,
2758 while (sp >= next_frame_bottom) {
2759 sp[displacement] = *sp;
2763 (P_)prev_frame = (P_)frame + displacement;
2767 tso->sp += displacement;
2768 tso->su = prev_frame;
2771 /* -----------------------------------------------------------------------------
2774 * We have to prepare for GC - this means doing lazy black holing
2775 * here. We also take the opportunity to do stack squeezing if it's
2777 * -------------------------------------------------------------------------- */
2780 threadPaused(StgTSO *tso)
2782 if ( RtsFlags.GcFlags.squeezeUpdFrames == rtsTrue )
2783 threadSqueezeStack(tso); /* does black holing too */
2785 threadLazyBlackHole(tso);