1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team 2001-2006
5 * Compacting garbage collector
7 * Documentation on the architecture of the Garbage Collector can be
8 * found in the online commentary:
10 * http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
12 * ---------------------------------------------------------------------------*/
14 #include "PosixSource.h"
18 #include "OSThreads.h"
19 #include "BlockAlloc.h"
27 // Turn off inlining when debugging - it obfuscates things
30 # define STATIC_INLINE static
33 /* -----------------------------------------------------------------------------
34 Threading / unthreading pointers.
36 The basic idea here is to chain together all the fields pointing at
37 a particular object, with the root of the chain in the object's
38 info table field. The original contents of the info pointer goes
39 at the end of the chain.
41 Adding a new field to the chain is a matter of swapping the
42 contents of the field with the contents of the object's info table
45 To unthread the chain, we walk down it updating all the fields on
46 the chain with the new location of the object. We stop when we
47 reach the info pointer at the end.
49 We use a trick to identify the info pointer: when swapping pointers
50 for threading, we set the low bit of the original pointer, with the
51 result that all the pointers in the chain have their low bits set
52 except for the info pointer.
53 -------------------------------------------------------------------------- */
56 thread (StgClosure **p)
59 StgPtr q = (StgPtr)UNTAG_CLOSURE(q0);
60 nat tag = GET_CLOSURE_TAG(q0);
63 // It doesn't look like a closure at the moment, because the info
64 // ptr is possibly threaded:
65 // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
67 // We need one tag value here, because we a non-zero tag to
68 // indicate "not an info pointer". So we add one to the existing
69 // tag. If this would overflow the tag bits, we throw away the
70 // original tag (which is safe but pessimistic; tags are optional).
71 if (tag == TAG_MASK) tag = 0;
76 // a handy way to discover whether the ptr is into the
77 // compacted area of the old gen, is that the EVACUATED flag
78 // is zero (it's non-zero for all the other areas of live
80 if ((bd->flags & BF_EVACUATED) == 0)
82 *(StgPtr)p = (StgWord)*q;
83 *q = (StgWord)p + tag + 1; // set the low bit
88 // This version of thread() takes a (void *), used to circumvent
89 // warnings from gcc about pointer punning and strict aliasing.
90 STATIC_INLINE void thread_ (void *p) { thread((StgClosure **)p); }
93 unthread( StgPtr p, StgPtr free )
99 while (GET_CLOSURE_TAG((StgClosure *)q) != 0) {
100 q -= 1; // restore the original tag
101 tag = GET_CLOSURE_TAG((StgClosure *)q);
102 q1 = (StgPtr)UNTAG_CLOSURE((StgClosure *)q);
104 *q1 = (StgWord)free + tag;
110 STATIC_INLINE StgInfoTable *
111 get_threaded_info( StgPtr p )
113 StgPtr q = (P_)GET_INFO(UNTAG_CLOSURE((StgClosure *)p));
115 while (GET_CLOSURE_TAG((StgClosure *)q) != 0) {
116 q = (P_)*((StgPtr)((StgWord)(UNTAG_CLOSURE((StgClosure *)q))));
119 ASSERT(LOOKS_LIKE_INFO_PTR(q));
120 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
123 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
124 // Remember, the two regions *might* overlap, but: to <= from.
126 move(StgPtr to, StgPtr from, nat size)
128 for(; size > 0; --size) {
134 thread_static( StgClosure* p )
136 const StgInfoTable *info;
138 // keep going until we've threaded all the objects on the linked
140 while (p != END_OF_STATIC_LIST) {
143 switch (info->type) {
146 thread(&((StgInd *)p)->indirectee);
147 p = *IND_STATIC_LINK(p);
151 p = *THUNK_STATIC_LINK(p);
154 p = *FUN_STATIC_LINK(p);
157 p = *STATIC_LINK(info,p);
161 barf("thread_static: strange closure %d", (int)(info->type));
168 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
174 bitmap = large_bitmap->bitmap[b];
175 for (i = 0; i < size; ) {
176 if ((bitmap & 1) == 0) {
177 thread((StgClosure **)p);
181 if (i % BITS_IN(W_) == 0) {
183 bitmap = large_bitmap->bitmap[b];
185 bitmap = bitmap >> 1;
191 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
198 switch (fun_info->f.fun_type) {
200 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
201 size = BITMAP_SIZE(fun_info->f.b.bitmap);
204 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
205 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
209 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
210 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
213 if ((bitmap & 1) == 0) {
214 thread((StgClosure **)p);
217 bitmap = bitmap >> 1;
226 thread_stack(StgPtr p, StgPtr stack_end)
228 const StgRetInfoTable* info;
232 // highly similar to scavenge_stack, but we do pointer threading here.
234 while (p < stack_end) {
236 // *p must be the info pointer of an activation
237 // record. All activation records have 'bitmap' style layout
240 info = get_ret_itbl((StgClosure *)p);
242 switch (info->i.type) {
244 // Dynamic bitmap: the mask is stored on the stack
248 dyn = ((StgRetDyn *)p)->liveness;
250 // traverse the bitmap first
251 bitmap = RET_DYN_LIVENESS(dyn);
252 p = (P_)&((StgRetDyn *)p)->payload[0];
253 size = RET_DYN_BITMAP_SIZE;
255 if ((bitmap & 1) == 0) {
256 thread((StgClosure **)p);
259 bitmap = bitmap >> 1;
263 // skip over the non-ptr words
264 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
266 // follow the ptr words
267 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
268 thread((StgClosure **)p);
274 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
275 case CATCH_RETRY_FRAME:
276 case CATCH_STM_FRAME:
277 case ATOMICALLY_FRAME:
282 bitmap = BITMAP_BITS(info->i.layout.bitmap);
283 size = BITMAP_SIZE(info->i.layout.bitmap);
285 // NOTE: the payload starts immediately after the info-ptr, we
286 // don't have an StgHeader in the same sense as a heap closure.
288 if ((bitmap & 1) == 0) {
289 thread((StgClosure **)p);
292 bitmap = bitmap >> 1;
303 thread((StgClosure **)p);
305 size = BCO_BITMAP_SIZE(bco);
306 thread_large_bitmap(p, BCO_BITMAP(bco), size);
311 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
314 size = GET_LARGE_BITMAP(&info->i)->size;
315 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
321 StgRetFun *ret_fun = (StgRetFun *)p;
322 StgFunInfoTable *fun_info;
324 fun_info = itbl_to_fun_itbl(
325 get_threaded_info((StgPtr)ret_fun->fun));
326 // *before* threading it!
327 thread(&ret_fun->fun);
328 p = thread_arg_block(fun_info, ret_fun->payload);
333 barf("thread_stack: weird activation record found on stack: %d",
334 (int)(info->i.type));
340 thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
344 StgFunInfoTable *fun_info;
346 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)fun));
347 ASSERT(fun_info->i.type != PAP);
351 switch (fun_info->f.fun_type) {
353 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
356 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
360 thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
364 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
367 if ((bitmap & 1) == 0) {
368 thread((StgClosure **)p);
371 bitmap = bitmap >> 1;
381 thread_PAP (StgPAP *pap)
384 p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
390 thread_AP (StgAP *ap)
393 p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
399 thread_AP_STACK (StgAP_STACK *ap)
402 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
403 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
407 thread_TSO (StgTSO *tso)
410 thread_(&tso->global_link);
412 if ( tso->why_blocked == BlockedOnMVar
413 || tso->why_blocked == BlockedOnBlackHole
414 || tso->why_blocked == BlockedOnException
416 thread_(&tso->block_info.closure);
418 thread_(&tso->blocked_exceptions);
422 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
423 return (StgPtr)tso + tso_sizeW(tso);
428 update_fwd_large( bdescr *bd )
431 const StgInfoTable* info;
433 for (; bd != NULL; bd = bd->link) {
436 info = get_itbl((StgClosure *)p);
438 switch (info->type) {
444 case MUT_ARR_PTRS_CLEAN:
445 case MUT_ARR_PTRS_DIRTY:
446 case MUT_ARR_PTRS_FROZEN:
447 case MUT_ARR_PTRS_FROZEN0:
452 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
453 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
454 thread((StgClosure **)p);
460 thread_TSO((StgTSO *)p);
464 thread_AP_STACK((StgAP_STACK *)p);
468 thread_PAP((StgPAP *)p);
474 StgTRecChunk *tc = (StgTRecChunk *)p;
475 TRecEntry *e = &(tc -> entries[0]);
476 thread_(&tc->prev_chunk);
477 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
479 thread(&e->expected_value);
480 thread(&e->new_value);
486 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
491 // ToDo: too big to inline
492 static /* STATIC_INLINE */ StgPtr
493 thread_obj (StgInfoTable *info, StgPtr p)
495 switch (info->type) {
497 return p + sizeofW(StgThunk) + 1;
501 return p + sizeofW(StgHeader) + 1;
505 thread(&((StgClosure *)p)->payload[0]);
506 return p + sizeofW(StgHeader) + 1;
509 thread(&((StgThunk *)p)->payload[0]);
510 return p + sizeofW(StgThunk) + 1;
513 return p + sizeofW(StgThunk) + 2;
517 return p + sizeofW(StgHeader) + 2;
520 thread(&((StgThunk *)p)->payload[0]);
521 return p + sizeofW(StgThunk) + 2;
525 thread(&((StgClosure *)p)->payload[0]);
526 return p + sizeofW(StgHeader) + 2;
529 thread(&((StgThunk *)p)->payload[0]);
530 thread(&((StgThunk *)p)->payload[1]);
531 return p + sizeofW(StgThunk) + 2;
535 thread(&((StgClosure *)p)->payload[0]);
536 thread(&((StgClosure *)p)->payload[1]);
537 return p + sizeofW(StgHeader) + 2;
540 StgBCO *bco = (StgBCO *)p;
541 thread_(&bco->instrs);
542 thread_(&bco->literals);
544 return p + bco_sizeW(bco);
551 end = (P_)((StgThunk *)p)->payload +
552 info->layout.payload.ptrs;
553 for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
554 thread((StgClosure **)p);
556 return p + info->layout.payload.nptrs;
566 case SE_CAF_BLACKHOLE:
572 end = (P_)((StgClosure *)p)->payload +
573 info->layout.payload.ptrs;
574 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
575 thread((StgClosure **)p);
577 return p + info->layout.payload.nptrs;
582 StgWeak *w = (StgWeak *)p;
585 thread(&w->finalizer);
586 if (w->link != NULL) {
589 return p + sizeofW(StgWeak);
594 StgMVar *mvar = (StgMVar *)p;
595 thread_(&mvar->head);
596 thread_(&mvar->tail);
597 thread(&mvar->value);
598 return p + sizeofW(StgMVar);
602 case IND_OLDGEN_PERM:
603 thread(&((StgInd *)p)->indirectee);
604 return p + sizeofW(StgInd);
608 StgSelector *s = (StgSelector *)p;
609 thread(&s->selectee);
610 return p + THUNK_SELECTOR_sizeW();
614 return thread_AP_STACK((StgAP_STACK *)p);
617 return thread_PAP((StgPAP *)p);
620 return thread_AP((StgAP *)p);
623 return p + arr_words_sizeW((StgArrWords *)p);
625 case MUT_ARR_PTRS_CLEAN:
626 case MUT_ARR_PTRS_DIRTY:
627 case MUT_ARR_PTRS_FROZEN:
628 case MUT_ARR_PTRS_FROZEN0:
633 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
634 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
635 thread((StgClosure **)p);
641 return thread_TSO((StgTSO *)p);
643 case TVAR_WATCH_QUEUE:
645 StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p;
646 thread_(&wq->closure);
647 thread_(&wq->next_queue_entry);
648 thread_(&wq->prev_queue_entry);
649 return p + sizeofW(StgTVarWatchQueue);
654 StgTVar *tvar = (StgTVar *)p;
655 thread((void *)&tvar->current_value);
656 thread((void *)&tvar->first_watch_queue_entry);
657 return p + sizeofW(StgTVar);
662 StgTRecHeader *trec = (StgTRecHeader *)p;
663 thread_(&trec->enclosing_trec);
664 thread_(&trec->current_chunk);
665 thread_(&trec->invariants_to_check);
666 return p + sizeofW(StgTRecHeader);
672 StgTRecChunk *tc = (StgTRecChunk *)p;
673 TRecEntry *e = &(tc -> entries[0]);
674 thread_(&tc->prev_chunk);
675 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
677 thread(&e->expected_value);
678 thread(&e->new_value);
680 return p + sizeofW(StgTRecChunk);
683 case ATOMIC_INVARIANT:
685 StgAtomicInvariant *invariant = (StgAtomicInvariant *)p;
686 thread_(&invariant->code);
687 thread_(&invariant->last_execution);
688 return p + sizeofW(StgAtomicInvariant);
691 case INVARIANT_CHECK_QUEUE:
693 StgInvariantCheckQueue *queue = (StgInvariantCheckQueue *)p;
694 thread_(&queue->invariant);
695 thread_(&queue->my_execution);
696 thread_(&queue->next_queue_entry);
697 return p + sizeofW(StgInvariantCheckQueue);
701 barf("update_fwd: unknown/strange object %d", (int)(info->type));
707 update_fwd( bdescr *blocks )
715 // cycle through all the blocks in the step
716 for (; bd != NULL; bd = bd->link) {
719 // linearly scan the objects in this block
720 while (p < bd->free) {
721 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
722 info = get_itbl((StgClosure *)p);
723 p = thread_obj(info, p);
729 update_fwd_compact( bdescr *blocks )
735 bdescr *bd, *free_bd;
741 free = free_bd->start;
743 // cycle through all the blocks in the step
744 for (; bd != NULL; bd = bd->link) {
747 while (p < bd->free ) {
749 while ( p < bd->free && !is_marked(p,bd) ) {
758 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
759 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
761 while ( p < bd->free ) {
766 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
774 // Problem: we need to know the destination for this cell
775 // in order to unthread its info pointer. But we can't
776 // know the destination without the size, because we may
777 // spill into the next block. So we have to run down the
778 // threaded list and get the info ptr first.
780 // ToDo: one possible avenue of attack is to use the fact
781 // that if (p&BLOCK_MASK) >= (free&BLOCK_MASK), then we
782 // definitely have enough room. Also see bug #1147.
783 info = get_threaded_info(p);
787 p = thread_obj(info, p);
790 if (free + size > free_bd->start + BLOCK_SIZE_W) {
791 // unset the next bit in the bitmap to indicate that
792 // this object needs to be pushed into the next
793 // block. This saves us having to run down the
794 // threaded info pointer list twice during the next pass.
796 free_bd = free_bd->link;
797 free = free_bd->start;
799 ASSERT(is_marked(q+1,bd));
812 update_bkwd_compact( step *stp )
818 bdescr *bd, *free_bd;
820 nat size, free_blocks;
822 bd = free_bd = stp->old_blocks;
823 free = free_bd->start;
826 // cycle through all the blocks in the step
827 for (; bd != NULL; bd = bd->link) {
830 while (p < bd->free ) {
832 while ( p < bd->free && !is_marked(p,bd) ) {
841 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
842 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
844 while ( p < bd->free ) {
849 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
857 if (!is_marked(p+1,bd)) {
858 // don't forget to update the free ptr in the block desc.
859 free_bd->free = free;
860 free_bd = free_bd->link;
861 free = free_bd->start;
866 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
867 info = get_itbl((StgClosure *)p);
868 size = closure_sizeW_((StgClosure *)p,info);
875 if (info->type == TSO) {
876 move_TSO((StgTSO *)p, (StgTSO *)free);
887 // free the remaining blocks and count what's left.
888 free_bd->free = free;
889 if (free_bd->link != NULL) {
890 freeChain(free_bd->link);
891 free_bd->link = NULL;
903 // 1. thread the roots
904 GetRoots((evac_fn)thread);
906 // the weak pointer lists...
907 if (weak_ptr_list != NULL) {
908 thread((void *)&weak_ptr_list);
910 if (old_weak_ptr_list != NULL) {
911 thread((void *)&old_weak_ptr_list); // tmp
915 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
918 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
919 for (p = bd->start; p < bd->free; p++) {
920 thread((StgClosure **)p);
925 // the global thread list
926 thread((void *)&all_threads);
928 // any threads resurrected during this GC
929 thread((void *)&resurrected_threads);
934 for (task = all_tasks; task != NULL; task = task->all_link) {
941 // the static objects
942 thread_static(scavenged_static_objects);
944 // the stable pointer table
945 threadStablePtrTable((evac_fn)thread);
947 // the CAF list (used by GHCi)
948 markCAFs((evac_fn)thread);
950 // 2. update forward ptrs
951 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
952 for (s = 0; s < generations[g].n_steps; s++) {
953 if (g==0 && s ==0) continue;
954 stp = &generations[g].steps[s];
955 debugTrace(DEBUG_gc, "update_fwd: %d.%d",
956 stp->gen->no, stp->no);
958 update_fwd(stp->blocks);
959 update_fwd_large(stp->scavenged_large_objects);
960 if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
961 debugTrace(DEBUG_gc, "update_fwd: %d.%d (compact)",
962 stp->gen->no, stp->no);
963 update_fwd_compact(stp->old_blocks);
968 // 3. update backward ptrs
969 stp = &oldest_gen->steps[0];
970 if (stp->old_blocks != NULL) {
971 blocks = update_bkwd_compact(stp);
973 "update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)",
974 stp->gen->no, stp->no,
975 stp->n_old_blocks, blocks);
976 stp->n_old_blocks = blocks;