1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team 2001-2008
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"
19 #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 The main difficulty here is that we need to be able to identify the
52 info pointer at the end of the chain. We can't use the low bits of
53 the pointer for this; they are already being used for
54 pointer-tagging. What's more, we need to retain the
55 pointer-tagging tag bits on each pointer during the
56 threading/unthreading process.
58 Our solution is as follows:
59 - an info pointer (chain length zero) is identified by having tag 0
60 - in a threaded chain of length > 0:
61 - the pointer-tagging tag bits are attached to the info pointer
62 - the first entry in the chain has tag 1
63 - second and subsequent entries in the chain have tag 2
65 This exploits the fact that the tag on each pointer to a given
66 closure is normally the same (if they are not the same, then
67 presumably the tag is not essential and it therefore doesn't matter
68 if we throw away some of the tags).
69 ------------------------------------------------------------------------- */
72 thread (StgClosure **p)
80 q = (StgPtr)UNTAG_CLOSURE(q0);
82 // It doesn't look like a closure at the moment, because the info
83 // ptr is possibly threaded:
84 // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
86 if (HEAP_ALLOCED(q)) {
89 if (bd->flags & BF_MARKED)
92 switch (GET_CLOSURE_TAG((StgClosure *)iptr))
95 // this is the info pointer; we are creating a new chain.
96 // save the original tag at the end of the chain.
97 *p = (StgClosure *)((StgWord)iptr + GET_CLOSURE_TAG(q0));
102 // this is a chain of length 1 or more
103 *p = (StgClosure *)iptr;
112 thread_root (void *user STG_UNUSED, StgClosure **p)
117 // This version of thread() takes a (void *), used to circumvent
118 // warnings from gcc about pointer punning and strict aliasing.
119 STATIC_INLINE void thread_ (void *p) { thread((StgClosure **)p); }
122 unthread( StgPtr p, StgWord free )
129 switch (GET_CLOSURE_TAG((StgClosure *)q))
132 // nothing to do; the chain is length zero
136 r = *q0; // r is the info ptr, tagged with the pointer-tag
138 *p = (StgWord)UNTAG_CLOSURE((StgClosure *)r);
151 // Traverse a threaded chain and pull out the info pointer at the end.
152 // The info pointer is also tagged with the appropriate pointer tag
153 // for this closure, which should be attached to the pointer
154 // subsequently passed to unthread().
155 STATIC_INLINE StgWord
156 get_threaded_info( StgPtr p )
160 q = (W_)GET_INFO(UNTAG_CLOSURE((StgClosure *)p));
163 switch (GET_CLOSURE_TAG((StgClosure *)q))
166 ASSERT(LOOKS_LIKE_INFO_PTR(q));
170 StgWord r = *(StgPtr)(q-1);
171 ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)UNTAG_CLOSURE((StgClosure *)r)));
178 barf("get_threaded_info");
182 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
183 // Remember, the two regions *might* overlap, but: to <= from.
185 move(StgPtr to, StgPtr from, nat size)
187 for(; size > 0; --size) {
193 thread_static( StgClosure* p )
195 const StgInfoTable *info;
197 // keep going until we've threaded all the objects on the linked
199 while (p != END_OF_STATIC_LIST) {
202 switch (info->type) {
205 thread(&((StgInd *)p)->indirectee);
206 p = *IND_STATIC_LINK(p);
210 p = *THUNK_STATIC_LINK(p);
213 p = *FUN_STATIC_LINK(p);
216 p = *STATIC_LINK(info,p);
220 barf("thread_static: strange closure %d", (int)(info->type));
227 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
233 bitmap = large_bitmap->bitmap[b];
234 for (i = 0; i < size; ) {
235 if ((bitmap & 1) == 0) {
236 thread((StgClosure **)p);
240 if (i % BITS_IN(W_) == 0) {
242 bitmap = large_bitmap->bitmap[b];
244 bitmap = bitmap >> 1;
250 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
257 switch (fun_info->f.fun_type) {
259 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
260 size = BITMAP_SIZE(fun_info->f.b.bitmap);
263 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
264 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
268 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
269 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
272 if ((bitmap & 1) == 0) {
273 thread((StgClosure **)p);
276 bitmap = bitmap >> 1;
285 thread_stack(StgPtr p, StgPtr stack_end)
287 const StgRetInfoTable* info;
291 // highly similar to scavenge_stack, but we do pointer threading here.
293 while (p < stack_end) {
295 // *p must be the info pointer of an activation
296 // record. All activation records have 'bitmap' style layout
299 info = get_ret_itbl((StgClosure *)p);
301 switch (info->i.type) {
303 // Dynamic bitmap: the mask is stored on the stack
307 dyn = ((StgRetDyn *)p)->liveness;
309 // traverse the bitmap first
310 bitmap = RET_DYN_LIVENESS(dyn);
311 p = (P_)&((StgRetDyn *)p)->payload[0];
312 size = RET_DYN_BITMAP_SIZE;
314 if ((bitmap & 1) == 0) {
315 thread((StgClosure **)p);
318 bitmap = bitmap >> 1;
322 // skip over the non-ptr words
323 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
325 // follow the ptr words
326 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
327 thread((StgClosure **)p);
333 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
334 case CATCH_RETRY_FRAME:
335 case CATCH_STM_FRAME:
336 case ATOMICALLY_FRAME:
341 bitmap = BITMAP_BITS(info->i.layout.bitmap);
342 size = BITMAP_SIZE(info->i.layout.bitmap);
344 // NOTE: the payload starts immediately after the info-ptr, we
345 // don't have an StgHeader in the same sense as a heap closure.
347 if ((bitmap & 1) == 0) {
348 thread((StgClosure **)p);
351 bitmap = bitmap >> 1;
362 thread((StgClosure **)p);
364 size = BCO_BITMAP_SIZE(bco);
365 thread_large_bitmap(p, BCO_BITMAP(bco), size);
370 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
373 size = GET_LARGE_BITMAP(&info->i)->size;
374 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
380 StgRetFun *ret_fun = (StgRetFun *)p;
381 StgFunInfoTable *fun_info;
383 fun_info = FUN_INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)
384 get_threaded_info((StgPtr)ret_fun->fun)));
385 // *before* threading it!
386 thread(&ret_fun->fun);
387 p = thread_arg_block(fun_info, ret_fun->payload);
392 barf("thread_stack: weird activation record found on stack: %d",
393 (int)(info->i.type));
399 thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
403 StgFunInfoTable *fun_info;
405 fun_info = FUN_INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)
406 get_threaded_info((StgPtr)fun)));
407 ASSERT(fun_info->i.type != PAP);
411 switch (fun_info->f.fun_type) {
413 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
416 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
420 thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
424 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
427 if ((bitmap & 1) == 0) {
428 thread((StgClosure **)p);
431 bitmap = bitmap >> 1;
441 thread_PAP (StgPAP *pap)
444 p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
450 thread_AP (StgAP *ap)
453 p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
459 thread_AP_STACK (StgAP_STACK *ap)
462 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
463 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
467 thread_TSO (StgTSO *tso)
469 thread_(&tso->_link);
470 thread_(&tso->global_link);
472 if ( tso->why_blocked == BlockedOnMVar
473 || tso->why_blocked == BlockedOnBlackHole
474 || tso->why_blocked == BlockedOnException
476 thread_(&tso->block_info.closure);
478 thread_(&tso->blocked_exceptions);
482 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
483 return (StgPtr)tso + tso_sizeW(tso);
488 update_fwd_large( bdescr *bd )
491 const StgInfoTable* info;
493 for (; bd != NULL; bd = bd->link) {
495 // nothing to do in a pinned block; it might not even have an object
497 if (bd->flags & BF_PINNED) continue;
500 info = get_itbl((StgClosure *)p);
502 switch (info->type) {
508 case MUT_ARR_PTRS_CLEAN:
509 case MUT_ARR_PTRS_DIRTY:
510 case MUT_ARR_PTRS_FROZEN:
511 case MUT_ARR_PTRS_FROZEN0:
516 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
517 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
518 thread((StgClosure **)p);
524 thread_TSO((StgTSO *)p);
528 thread_AP_STACK((StgAP_STACK *)p);
532 thread_PAP((StgPAP *)p);
538 StgTRecChunk *tc = (StgTRecChunk *)p;
539 TRecEntry *e = &(tc -> entries[0]);
540 thread_(&tc->prev_chunk);
541 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
543 thread(&e->expected_value);
544 thread(&e->new_value);
550 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
555 // ToDo: too big to inline
556 static /* STATIC_INLINE */ StgPtr
557 thread_obj (StgInfoTable *info, StgPtr p)
559 switch (info->type) {
561 return p + sizeofW(StgThunk) + 1;
565 return p + sizeofW(StgHeader) + 1;
569 thread(&((StgClosure *)p)->payload[0]);
570 return p + sizeofW(StgHeader) + 1;
573 thread(&((StgThunk *)p)->payload[0]);
574 return p + sizeofW(StgThunk) + 1;
577 return p + sizeofW(StgThunk) + 2;
581 return p + sizeofW(StgHeader) + 2;
584 thread(&((StgThunk *)p)->payload[0]);
585 return p + sizeofW(StgThunk) + 2;
589 thread(&((StgClosure *)p)->payload[0]);
590 return p + sizeofW(StgHeader) + 2;
593 thread(&((StgThunk *)p)->payload[0]);
594 thread(&((StgThunk *)p)->payload[1]);
595 return p + sizeofW(StgThunk) + 2;
599 thread(&((StgClosure *)p)->payload[0]);
600 thread(&((StgClosure *)p)->payload[1]);
601 return p + sizeofW(StgHeader) + 2;
604 StgBCO *bco = (StgBCO *)p;
605 thread_(&bco->instrs);
606 thread_(&bco->literals);
608 return p + bco_sizeW(bco);
615 end = (P_)((StgThunk *)p)->payload +
616 info->layout.payload.ptrs;
617 for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
618 thread((StgClosure **)p);
620 return p + info->layout.payload.nptrs;
634 end = (P_)((StgClosure *)p)->payload +
635 info->layout.payload.ptrs;
636 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
637 thread((StgClosure **)p);
639 return p + info->layout.payload.nptrs;
644 StgWeak *w = (StgWeak *)p;
645 thread(&w->cfinalizer);
648 thread(&w->finalizer);
649 if (w->link != NULL) {
652 return p + sizeofW(StgWeak);
658 StgMVar *mvar = (StgMVar *)p;
659 thread_(&mvar->head);
660 thread_(&mvar->tail);
661 thread(&mvar->value);
662 return p + sizeofW(StgMVar);
666 case IND_OLDGEN_PERM:
667 thread(&((StgInd *)p)->indirectee);
668 return p + sizeofW(StgInd);
672 StgSelector *s = (StgSelector *)p;
673 thread(&s->selectee);
674 return p + THUNK_SELECTOR_sizeW();
678 return thread_AP_STACK((StgAP_STACK *)p);
681 return thread_PAP((StgPAP *)p);
684 return thread_AP((StgAP *)p);
687 return p + arr_words_sizeW((StgArrWords *)p);
689 case MUT_ARR_PTRS_CLEAN:
690 case MUT_ARR_PTRS_DIRTY:
691 case MUT_ARR_PTRS_FROZEN:
692 case MUT_ARR_PTRS_FROZEN0:
697 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
698 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
699 thread((StgClosure **)p);
705 return thread_TSO((StgTSO *)p);
707 case TVAR_WATCH_QUEUE:
709 StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p;
710 thread_(&wq->closure);
711 thread_(&wq->next_queue_entry);
712 thread_(&wq->prev_queue_entry);
713 return p + sizeofW(StgTVarWatchQueue);
718 StgTVar *tvar = (StgTVar *)p;
719 thread((void *)&tvar->current_value);
720 thread((void *)&tvar->first_watch_queue_entry);
721 return p + sizeofW(StgTVar);
726 StgTRecHeader *trec = (StgTRecHeader *)p;
727 thread_(&trec->enclosing_trec);
728 thread_(&trec->current_chunk);
729 thread_(&trec->invariants_to_check);
730 return p + sizeofW(StgTRecHeader);
736 StgTRecChunk *tc = (StgTRecChunk *)p;
737 TRecEntry *e = &(tc -> entries[0]);
738 thread_(&tc->prev_chunk);
739 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
741 thread(&e->expected_value);
742 thread(&e->new_value);
744 return p + sizeofW(StgTRecChunk);
747 case ATOMIC_INVARIANT:
749 StgAtomicInvariant *invariant = (StgAtomicInvariant *)p;
750 thread_(&invariant->code);
751 thread_(&invariant->last_execution);
752 return p + sizeofW(StgAtomicInvariant);
755 case INVARIANT_CHECK_QUEUE:
757 StgInvariantCheckQueue *queue = (StgInvariantCheckQueue *)p;
758 thread_(&queue->invariant);
759 thread_(&queue->my_execution);
760 thread_(&queue->next_queue_entry);
761 return p + sizeofW(StgInvariantCheckQueue);
765 barf("update_fwd: unknown/strange object %d", (int)(info->type));
771 update_fwd( bdescr *blocks )
779 // cycle through all the blocks in the step
780 for (; bd != NULL; bd = bd->link) {
783 // linearly scan the objects in this block
784 while (p < bd->free) {
785 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
786 info = get_itbl((StgClosure *)p);
787 p = thread_obj(info, p);
793 update_fwd_compact( bdescr *blocks )
799 bdescr *bd, *free_bd;
806 free = free_bd->start;
808 // cycle through all the blocks in the step
809 for (; bd != NULL; bd = bd->link) {
812 while (p < bd->free ) {
814 while ( p < bd->free && !is_marked(p,bd) ) {
823 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
824 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
826 while ( p < bd->free ) {
831 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
839 // Problem: we need to know the destination for this cell
840 // in order to unthread its info pointer. But we can't
841 // know the destination without the size, because we may
842 // spill into the next block. So we have to run down the
843 // threaded list and get the info ptr first.
845 // ToDo: one possible avenue of attack is to use the fact
846 // that if (p&BLOCK_MASK) >= (free&BLOCK_MASK), then we
847 // definitely have enough room. Also see bug #1147.
848 iptr = get_threaded_info(p);
849 info = INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)iptr));
853 p = thread_obj(info, p);
856 if (free + size > free_bd->start + BLOCK_SIZE_W) {
857 // set the next bit in the bitmap to indicate that
858 // this object needs to be pushed into the next
859 // block. This saves us having to run down the
860 // threaded info pointer list twice during the next pass.
862 free_bd = free_bd->link;
863 free = free_bd->start;
865 ASSERT(!is_marked(q+1,bd));
868 unthread(q,(StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
878 update_bkwd_compact( step *stp )
884 bdescr *bd, *free_bd;
886 nat size, free_blocks;
889 bd = free_bd = stp->old_blocks;
890 free = free_bd->start;
893 // cycle through all the blocks in the step
894 for (; bd != NULL; bd = bd->link) {
897 while (p < bd->free ) {
899 while ( p < bd->free && !is_marked(p,bd) ) {
908 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
909 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
911 while ( p < bd->free ) {
916 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
924 if (is_marked(p+1,bd)) {
925 // don't forget to update the free ptr in the block desc.
926 free_bd->free = free;
927 free_bd = free_bd->link;
928 free = free_bd->start;
932 iptr = get_threaded_info(p);
933 unthread(p, (StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
934 ASSERT(LOOKS_LIKE_INFO_PTR((StgWord)((StgClosure *)p)->header.info));
935 info = get_itbl((StgClosure *)p);
936 size = closure_sizeW_((StgClosure *)p,info);
943 if (info->type == TSO) {
944 move_TSO((StgTSO *)p, (StgTSO *)free);
955 // free the remaining blocks and count what's left.
956 free_bd->free = free;
957 if (free_bd->link != NULL) {
958 freeChain(free_bd->link);
959 free_bd->link = NULL;
966 compact(StgClosure *static_objects)
971 // 1. thread the roots
972 markCapabilities((evac_fn)thread_root, NULL);
974 // the weak pointer lists...
975 if (weak_ptr_list != NULL) {
976 thread((void *)&weak_ptr_list);
978 if (old_weak_ptr_list != NULL) {
979 thread((void *)&old_weak_ptr_list); // tmp
983 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
987 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
988 for (p = bd->start; p < bd->free; p++) {
989 thread((StgClosure **)p);
992 for (n = 0; n < n_capabilities; n++) {
993 for (bd = capabilities[n].mut_lists[g];
994 bd != NULL; bd = bd->link) {
995 for (p = bd->start; p < bd->free; p++) {
996 thread((StgClosure **)p);
1002 // the global thread list
1003 for (s = 0; s < total_steps; s++) {
1004 thread((void *)&all_steps[s].threads);
1007 // any threads resurrected during this GC
1008 thread((void *)&resurrected_threads);
1010 // the blackhole queue
1011 thread((void *)&blackhole_queue);
1016 for (task = all_tasks; task != NULL; task = task->all_link) {
1018 thread_(&task->tso);
1023 // the static objects
1024 thread_static(static_objects /* ToDo: ok? */);
1026 // the stable pointer table
1027 threadStablePtrTable((evac_fn)thread_root, NULL);
1029 // the CAF list (used by GHCi)
1030 markCAFs((evac_fn)thread_root, NULL);
1032 // 2. update forward ptrs
1033 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1034 for (s = 0; s < generations[g].n_steps; s++) {
1035 if (g==0 && s ==0) continue;
1036 stp = &generations[g].steps[s];
1037 debugTrace(DEBUG_gc, "update_fwd: %d.%d",
1038 stp->gen->no, stp->no);
1040 update_fwd(stp->blocks);
1041 update_fwd_large(stp->scavenged_large_objects);
1042 if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
1043 debugTrace(DEBUG_gc, "update_fwd: %d.%d (compact)",
1044 stp->gen->no, stp->no);
1045 update_fwd_compact(stp->old_blocks);
1050 // 3. update backward ptrs
1051 stp = &oldest_gen->steps[0];
1052 if (stp->old_blocks != NULL) {
1053 blocks = update_bkwd_compact(stp);
1054 debugTrace(DEBUG_gc,
1055 "update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)",
1056 stp->gen->no, stp->no,
1057 stp->n_old_blocks, blocks);
1058 stp->n_old_blocks = blocks;