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"
21 #include "BlockAlloc.h"
29 // Turn off inlining when debugging - it obfuscates things
32 # define STATIC_INLINE static
35 /* -----------------------------------------------------------------------------
36 Threading / unthreading pointers.
38 The basic idea here is to chain together all the fields pointing at
39 a particular object, with the root of the chain in the object's
40 info table field. The original contents of the info pointer goes
41 at the end of the chain.
43 Adding a new field to the chain is a matter of swapping the
44 contents of the field with the contents of the object's info table
47 To unthread the chain, we walk down it updating all the fields on
48 the chain with the new location of the object. We stop when we
49 reach the info pointer at the end.
51 We use a trick to identify the info pointer: when swapping pointers
52 for threading, we set the low bit of the original pointer, with the
53 result that all the pointers in the chain have their low bits set
54 except for the info pointer.
55 -------------------------------------------------------------------------- */
58 thread (StgClosure **p)
60 StgPtr q = *(StgPtr *)p;
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 if (HEAP_ALLOCED(q)) {
69 // a handy way to discover whether the ptr is into the
70 // compacted area of the old gen, is that the EVACUATED flag
71 // is zero (it's non-zero for all the other areas of live
73 if ((bd->flags & BF_EVACUATED) == 0) {
75 *(StgPtr)p = (StgWord)*q;
76 *q = (StgWord)p + 1; // set the low bit
81 // This version of thread() takes a (void *), used to circumvent
82 // warnings from gcc about pointer punning and strict aliasing.
83 STATIC_INLINE void thread_ (void *p) { thread((StgClosure **)p); }
86 unthread( StgPtr p, StgPtr free )
90 while ((q & 1) != 0) {
91 q -= 1; // unset the low bit again
93 *((StgPtr)q) = (StgWord)free;
99 STATIC_INLINE StgInfoTable *
100 get_threaded_info( StgPtr p )
102 StgPtr q = (P_)GET_INFO((StgClosure *)p);
104 while (((StgWord)q & 1) != 0) {
105 q = (P_)*((StgPtr)((StgWord)q-1));
108 ASSERT(LOOKS_LIKE_INFO_PTR(q));
109 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
112 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
113 // Remember, the two regions *might* overlap, but: to <= from.
115 move(StgPtr to, StgPtr from, nat size)
117 for(; size > 0; --size) {
123 thread_static( StgClosure* p )
125 const StgInfoTable *info;
127 // keep going until we've threaded all the objects on the linked
129 while (p != END_OF_STATIC_LIST) {
132 switch (info->type) {
135 thread(&((StgInd *)p)->indirectee);
136 p = *IND_STATIC_LINK(p);
140 p = *THUNK_STATIC_LINK(p);
143 p = *FUN_STATIC_LINK(p);
146 p = *STATIC_LINK(info,p);
150 barf("thread_static: strange closure %d", (int)(info->type));
157 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
163 bitmap = large_bitmap->bitmap[b];
164 for (i = 0; i < size; ) {
165 if ((bitmap & 1) == 0) {
166 thread((StgClosure **)p);
170 if (i % BITS_IN(W_) == 0) {
172 bitmap = large_bitmap->bitmap[b];
174 bitmap = bitmap >> 1;
180 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
187 switch (fun_info->f.fun_type) {
189 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
190 size = BITMAP_SIZE(fun_info->f.b.bitmap);
193 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
194 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
198 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
199 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
202 if ((bitmap & 1) == 0) {
203 thread((StgClosure **)p);
206 bitmap = bitmap >> 1;
215 thread_stack(StgPtr p, StgPtr stack_end)
217 const StgRetInfoTable* info;
221 // highly similar to scavenge_stack, but we do pointer threading here.
223 while (p < stack_end) {
225 // *p must be the info pointer of an activation
226 // record. All activation records have 'bitmap' style layout
229 info = get_ret_itbl((StgClosure *)p);
231 switch (info->i.type) {
233 // Dynamic bitmap: the mask is stored on the stack
237 dyn = ((StgRetDyn *)p)->liveness;
239 // traverse the bitmap first
240 bitmap = RET_DYN_LIVENESS(dyn);
241 p = (P_)&((StgRetDyn *)p)->payload[0];
242 size = RET_DYN_BITMAP_SIZE;
244 if ((bitmap & 1) == 0) {
245 thread((StgClosure **)p);
248 bitmap = bitmap >> 1;
252 // skip over the non-ptr words
253 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
255 // follow the ptr words
256 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
257 thread((StgClosure **)p);
263 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
264 case CATCH_RETRY_FRAME:
265 case CATCH_STM_FRAME:
266 case ATOMICALLY_FRAME:
272 bitmap = BITMAP_BITS(info->i.layout.bitmap);
273 size = BITMAP_SIZE(info->i.layout.bitmap);
275 // NOTE: the payload starts immediately after the info-ptr, we
276 // don't have an StgHeader in the same sense as a heap closure.
278 if ((bitmap & 1) == 0) {
279 thread((StgClosure **)p);
282 bitmap = bitmap >> 1;
293 thread((StgClosure **)p);
295 size = BCO_BITMAP_SIZE(bco);
296 thread_large_bitmap(p, BCO_BITMAP(bco), size);
301 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
305 size = GET_LARGE_BITMAP(&info->i)->size;
306 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
312 StgRetFun *ret_fun = (StgRetFun *)p;
313 StgFunInfoTable *fun_info;
315 fun_info = itbl_to_fun_itbl(
316 get_threaded_info((StgPtr)ret_fun->fun));
317 // *before* threading it!
318 thread(&ret_fun->fun);
319 p = thread_arg_block(fun_info, ret_fun->payload);
324 barf("thread_stack: weird activation record found on stack: %d",
325 (int)(info->i.type));
331 thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
335 StgFunInfoTable *fun_info;
337 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)fun));
338 ASSERT(fun_info->i.type != PAP);
342 switch (fun_info->f.fun_type) {
344 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
347 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
351 thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
355 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
358 if ((bitmap & 1) == 0) {
359 thread((StgClosure **)p);
362 bitmap = bitmap >> 1;
372 thread_PAP (StgPAP *pap)
375 p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
381 thread_AP (StgAP *ap)
384 p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
390 thread_AP_STACK (StgAP_STACK *ap)
393 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
394 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
398 thread_TSO (StgTSO *tso)
401 thread_(&tso->global_link);
403 if ( tso->why_blocked == BlockedOnMVar
404 || tso->why_blocked == BlockedOnBlackHole
405 || tso->why_blocked == BlockedOnException
407 thread_(&tso->block_info.closure);
409 thread_(&tso->blocked_exceptions);
413 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
414 return (StgPtr)tso + tso_sizeW(tso);
419 update_fwd_large( bdescr *bd )
422 const StgInfoTable* info;
424 for (; bd != NULL; bd = bd->link) {
427 info = get_itbl((StgClosure *)p);
429 switch (info->type) {
435 case MUT_ARR_PTRS_CLEAN:
436 case MUT_ARR_PTRS_DIRTY:
437 case MUT_ARR_PTRS_FROZEN:
438 case MUT_ARR_PTRS_FROZEN0:
443 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
444 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
445 thread((StgClosure **)p);
451 thread_TSO((StgTSO *)p);
455 thread_AP_STACK((StgAP_STACK *)p);
459 thread_PAP((StgPAP *)p);
465 StgTRecChunk *tc = (StgTRecChunk *)p;
466 TRecEntry *e = &(tc -> entries[0]);
467 thread_(&tc->prev_chunk);
468 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
470 thread(&e->expected_value);
471 thread(&e->new_value);
477 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
482 // ToDo: too big to inline
483 static /* STATIC_INLINE */ StgPtr
484 thread_obj (StgInfoTable *info, StgPtr p)
486 switch (info->type) {
488 return p + sizeofW(StgThunk) + 1;
492 return p + sizeofW(StgHeader) + 1;
496 thread(&((StgClosure *)p)->payload[0]);
497 return p + sizeofW(StgHeader) + 1;
500 thread(&((StgThunk *)p)->payload[0]);
501 return p + sizeofW(StgThunk) + 1;
504 return p + sizeofW(StgThunk) + 2;
508 return p + sizeofW(StgHeader) + 2;
511 thread(&((StgThunk *)p)->payload[0]);
512 return p + sizeofW(StgThunk) + 2;
516 thread(&((StgClosure *)p)->payload[0]);
517 return p + sizeofW(StgHeader) + 2;
520 thread(&((StgThunk *)p)->payload[0]);
521 thread(&((StgThunk *)p)->payload[1]);
522 return p + sizeofW(StgThunk) + 2;
526 thread(&((StgClosure *)p)->payload[0]);
527 thread(&((StgClosure *)p)->payload[1]);
528 return p + sizeofW(StgHeader) + 2;
531 StgBCO *bco = (StgBCO *)p;
532 thread_(&bco->instrs);
533 thread_(&bco->literals);
535 thread_(&bco->itbls);
536 return p + bco_sizeW(bco);
543 end = (P_)((StgThunk *)p)->payload +
544 info->layout.payload.ptrs;
545 for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
546 thread((StgClosure **)p);
548 return p + info->layout.payload.nptrs;
558 case SE_CAF_BLACKHOLE:
564 end = (P_)((StgClosure *)p)->payload +
565 info->layout.payload.ptrs;
566 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
567 thread((StgClosure **)p);
569 return p + info->layout.payload.nptrs;
574 StgWeak *w = (StgWeak *)p;
577 thread(&w->finalizer);
578 if (w->link != NULL) {
581 return p + sizeofW(StgWeak);
586 StgMVar *mvar = (StgMVar *)p;
587 thread_(&mvar->head);
588 thread_(&mvar->tail);
589 thread(&mvar->value);
590 return p + sizeofW(StgMVar);
594 case IND_OLDGEN_PERM:
595 thread(&((StgInd *)p)->indirectee);
596 return p + sizeofW(StgInd);
600 StgSelector *s = (StgSelector *)p;
601 thread(&s->selectee);
602 return p + THUNK_SELECTOR_sizeW();
606 return thread_AP_STACK((StgAP_STACK *)p);
609 return thread_PAP((StgPAP *)p);
612 return thread_AP((StgAP *)p);
615 return p + arr_words_sizeW((StgArrWords *)p);
617 case MUT_ARR_PTRS_CLEAN:
618 case MUT_ARR_PTRS_DIRTY:
619 case MUT_ARR_PTRS_FROZEN:
620 case MUT_ARR_PTRS_FROZEN0:
625 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
626 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
627 thread((StgClosure **)p);
633 return thread_TSO((StgTSO *)p);
635 case TVAR_WATCH_QUEUE:
637 StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p;
638 thread_(&wq->closure);
639 thread_(&wq->next_queue_entry);
640 thread_(&wq->prev_queue_entry);
641 return p + sizeofW(StgTVarWatchQueue);
646 StgTVar *tvar = (StgTVar *)p;
647 thread((void *)&tvar->current_value);
648 thread((void *)&tvar->first_watch_queue_entry);
649 return p + sizeofW(StgTVar);
654 StgTRecHeader *trec = (StgTRecHeader *)p;
655 thread_(&trec->enclosing_trec);
656 thread_(&trec->current_chunk);
657 thread_(&trec->invariants_to_check);
658 return p + sizeofW(StgTRecHeader);
664 StgTRecChunk *tc = (StgTRecChunk *)p;
665 TRecEntry *e = &(tc -> entries[0]);
666 thread_(&tc->prev_chunk);
667 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
669 thread(&e->expected_value);
670 thread(&e->new_value);
672 return p + sizeofW(StgTRecChunk);
675 case ATOMIC_INVARIANT:
677 StgAtomicInvariant *invariant = (StgAtomicInvariant *)p;
678 thread_(&invariant->code);
679 thread_(&invariant->last_execution);
680 return p + sizeofW(StgAtomicInvariant);
683 case INVARIANT_CHECK_QUEUE:
685 StgInvariantCheckQueue *queue = (StgInvariantCheckQueue *)p;
686 thread_(&queue->invariant);
687 thread_(&queue->my_execution);
688 thread_(&queue->next_queue_entry);
689 return p + sizeofW(StgInvariantCheckQueue);
693 barf("update_fwd: unknown/strange object %d", (int)(info->type));
699 update_fwd( bdescr *blocks )
707 // cycle through all the blocks in the step
708 for (; bd != NULL; bd = bd->link) {
711 // linearly scan the objects in this block
712 while (p < bd->free) {
713 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
714 info = get_itbl((StgClosure *)p);
715 p = thread_obj(info, p);
721 update_fwd_compact( bdescr *blocks )
727 bdescr *bd, *free_bd;
733 free = free_bd->start;
735 // cycle through all the blocks in the step
736 for (; bd != NULL; bd = bd->link) {
739 while (p < bd->free ) {
741 while ( p < bd->free && !is_marked(p,bd) ) {
750 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
751 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
753 while ( p < bd->free ) {
758 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
766 // Problem: we need to know the destination for this cell
767 // in order to unthread its info pointer. But we can't
768 // know the destination without the size, because we may
769 // spill into the next block. So we have to run down the
770 // threaded list and get the info ptr first.
771 info = get_threaded_info(p);
775 p = thread_obj(info, p);
778 if (free + size > free_bd->start + BLOCK_SIZE_W) {
779 // unset the next bit in the bitmap to indicate that
780 // this object needs to be pushed into the next
781 // block. This saves us having to run down the
782 // threaded info pointer list twice during the next pass.
784 free_bd = free_bd->link;
785 free = free_bd->start;
787 ASSERT(is_marked(q+1,bd));
800 update_bkwd_compact( step *stp )
806 bdescr *bd, *free_bd;
808 nat size, free_blocks;
810 bd = free_bd = stp->old_blocks;
811 free = free_bd->start;
814 // cycle through all the blocks in the step
815 for (; bd != NULL; bd = bd->link) {
818 while (p < bd->free ) {
820 while ( p < bd->free && !is_marked(p,bd) ) {
829 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
830 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
832 while ( p < bd->free ) {
837 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
845 if (!is_marked(p+1,bd)) {
846 // don't forget to update the free ptr in the block desc.
847 free_bd->free = free;
848 free_bd = free_bd->link;
849 free = free_bd->start;
854 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
855 info = get_itbl((StgClosure *)p);
856 size = closure_sizeW_((StgClosure *)p,info);
863 if (info->type == TSO) {
864 move_TSO((StgTSO *)p, (StgTSO *)free);
875 // free the remaining blocks and count what's left.
876 free_bd->free = free;
877 if (free_bd->link != NULL) {
878 freeChain(free_bd->link);
879 free_bd->link = NULL;
891 // 1. thread the roots
892 GetRoots((evac_fn)thread);
894 // the weak pointer lists...
895 if (weak_ptr_list != NULL) {
896 thread((void *)&weak_ptr_list);
898 if (old_weak_ptr_list != NULL) {
899 thread((void *)&old_weak_ptr_list); // tmp
903 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
906 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
907 for (p = bd->start; p < bd->free; p++) {
908 thread((StgClosure **)p);
913 // the global thread list
914 thread((void *)&all_threads);
916 // any threads resurrected during this GC
917 thread((void *)&resurrected_threads);
922 for (task = all_tasks; task != NULL; task = task->all_link) {
929 // the static objects
930 thread_static(scavenged_static_objects);
932 // the stable pointer table
933 threadStablePtrTable((evac_fn)thread);
935 // the CAF list (used by GHCi)
936 markCAFs((evac_fn)thread);
938 // 2. update forward ptrs
939 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
940 for (s = 0; s < generations[g].n_steps; s++) {
941 if (g==0 && s ==0) continue;
942 stp = &generations[g].steps[s];
943 debugTrace(DEBUG_gc, "update_fwd: %d.%d",
944 stp->gen->no, stp->no);
946 update_fwd(stp->blocks);
947 update_fwd_large(stp->scavenged_large_objects);
948 if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
949 debugTrace(DEBUG_gc, "update_fwd: %d.%d (compact)",
950 stp->gen->no, stp->no);
951 update_fwd_compact(stp->old_blocks);
956 // 3. update backward ptrs
957 stp = &oldest_gen->steps[0];
958 if (stp->old_blocks != NULL) {
959 blocks = update_bkwd_compact(stp);
961 "update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)",
962 stp->gen->no, stp->no,
963 stp->n_old_blocks, blocks);
964 stp->n_old_blocks = blocks;