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"
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 The main difficulty here is that we need to be able to identify the
50 info pointer at the end of the chain. We can't use the low bits of
51 the pointer for this; they are already being used for
52 pointer-tagging. What's more, we need to retain the
53 pointer-tagging tag bits on each pointer during the
54 threading/unthreading process.
56 Our solution is as follows:
57 - an info pointer (chain length zero) is identified by having tag 0
58 - in a threaded chain of length > 0:
59 - the pointer-tagging tag bits are attached to the info pointer
60 - the first entry in the chain has tag 1
61 - second and subsequent entries in the chain have tag 2
63 This exploits the fact that the tag on each pointer to a given
64 closure is normally the same (if they are not the same, then
65 presumably the tag is not essential and it therefore doesn't matter
66 if we throw away some of the tags).
67 ------------------------------------------------------------------------- */
70 thread (StgClosure **p)
78 q = (StgPtr)UNTAG_CLOSURE(q0);
80 // It doesn't look like a closure at the moment, because the info
81 // ptr is possibly threaded:
82 // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
84 if (HEAP_ALLOCED(q)) {
87 if (bd->flags & BF_MARKED)
90 switch (GET_CLOSURE_TAG((StgClosure *)iptr))
93 // this is the info pointer; we are creating a new chain.
94 // save the original tag at the end of the chain.
95 *p = (StgClosure *)((StgWord)iptr + GET_CLOSURE_TAG(q0));
100 // this is a chain of length 1 or more
101 *p = (StgClosure *)iptr;
110 thread_root (void *user STG_UNUSED, StgClosure **p)
115 // This version of thread() takes a (void *), used to circumvent
116 // warnings from gcc about pointer punning and strict aliasing.
117 STATIC_INLINE void thread_ (void *p) { thread((StgClosure **)p); }
120 unthread( StgPtr p, StgWord free )
127 switch (GET_CLOSURE_TAG((StgClosure *)q))
130 // nothing to do; the chain is length zero
134 r = *q0; // r is the info ptr, tagged with the pointer-tag
136 *p = (StgWord)UNTAG_CLOSURE((StgClosure *)r);
149 // Traverse a threaded chain and pull out the info pointer at the end.
150 // The info pointer is also tagged with the appropriate pointer tag
151 // for this closure, which should be attached to the pointer
152 // subsequently passed to unthread().
153 STATIC_INLINE StgWord
154 get_threaded_info( StgPtr p )
158 q = (W_)GET_INFO(UNTAG_CLOSURE((StgClosure *)p));
161 switch (GET_CLOSURE_TAG((StgClosure *)q))
164 ASSERT(LOOKS_LIKE_INFO_PTR(q));
168 StgWord r = *(StgPtr)(q-1);
169 ASSERT(LOOKS_LIKE_INFO_PTR(UNTAG_CLOSURE((StgClosure *)r)));
176 barf("get_threaded_info");
180 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
181 // Remember, the two regions *might* overlap, but: to <= from.
183 move(StgPtr to, StgPtr from, nat size)
185 for(; size > 0; --size) {
191 thread_static( StgClosure* p )
193 const StgInfoTable *info;
195 // keep going until we've threaded all the objects on the linked
197 while (p != END_OF_STATIC_LIST) {
200 switch (info->type) {
203 thread(&((StgInd *)p)->indirectee);
204 p = *IND_STATIC_LINK(p);
208 p = *THUNK_STATIC_LINK(p);
211 p = *FUN_STATIC_LINK(p);
214 p = *STATIC_LINK(info,p);
218 barf("thread_static: strange closure %d", (int)(info->type));
225 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
231 bitmap = large_bitmap->bitmap[b];
232 for (i = 0; i < size; ) {
233 if ((bitmap & 1) == 0) {
234 thread((StgClosure **)p);
238 if (i % BITS_IN(W_) == 0) {
240 bitmap = large_bitmap->bitmap[b];
242 bitmap = bitmap >> 1;
248 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
255 switch (fun_info->f.fun_type) {
257 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
258 size = BITMAP_SIZE(fun_info->f.b.bitmap);
261 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
262 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
266 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
267 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
270 if ((bitmap & 1) == 0) {
271 thread((StgClosure **)p);
274 bitmap = bitmap >> 1;
283 thread_stack(StgPtr p, StgPtr stack_end)
285 const StgRetInfoTable* info;
289 // highly similar to scavenge_stack, but we do pointer threading here.
291 while (p < stack_end) {
293 // *p must be the info pointer of an activation
294 // record. All activation records have 'bitmap' style layout
297 info = get_ret_itbl((StgClosure *)p);
299 switch (info->i.type) {
301 // Dynamic bitmap: the mask is stored on the stack
305 dyn = ((StgRetDyn *)p)->liveness;
307 // traverse the bitmap first
308 bitmap = RET_DYN_LIVENESS(dyn);
309 p = (P_)&((StgRetDyn *)p)->payload[0];
310 size = RET_DYN_BITMAP_SIZE;
312 if ((bitmap & 1) == 0) {
313 thread((StgClosure **)p);
316 bitmap = bitmap >> 1;
320 // skip over the non-ptr words
321 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
323 // follow the ptr words
324 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
325 thread((StgClosure **)p);
331 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
332 case CATCH_RETRY_FRAME:
333 case CATCH_STM_FRAME:
334 case ATOMICALLY_FRAME:
339 bitmap = BITMAP_BITS(info->i.layout.bitmap);
340 size = BITMAP_SIZE(info->i.layout.bitmap);
342 // NOTE: the payload starts immediately after the info-ptr, we
343 // don't have an StgHeader in the same sense as a heap closure.
345 if ((bitmap & 1) == 0) {
346 thread((StgClosure **)p);
349 bitmap = bitmap >> 1;
360 thread((StgClosure **)p);
362 size = BCO_BITMAP_SIZE(bco);
363 thread_large_bitmap(p, BCO_BITMAP(bco), size);
368 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
371 size = GET_LARGE_BITMAP(&info->i)->size;
372 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
378 StgRetFun *ret_fun = (StgRetFun *)p;
379 StgFunInfoTable *fun_info;
381 fun_info = FUN_INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)
382 get_threaded_info((StgPtr)ret_fun->fun)));
383 // *before* threading it!
384 thread(&ret_fun->fun);
385 p = thread_arg_block(fun_info, ret_fun->payload);
390 barf("thread_stack: weird activation record found on stack: %d",
391 (int)(info->i.type));
397 thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
401 StgFunInfoTable *fun_info;
403 fun_info = FUN_INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)
404 get_threaded_info((StgPtr)fun)));
405 ASSERT(fun_info->i.type != PAP);
409 switch (fun_info->f.fun_type) {
411 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
414 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
418 thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
422 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
425 if ((bitmap & 1) == 0) {
426 thread((StgClosure **)p);
429 bitmap = bitmap >> 1;
439 thread_PAP (StgPAP *pap)
442 p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
448 thread_AP (StgAP *ap)
451 p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
457 thread_AP_STACK (StgAP_STACK *ap)
460 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
461 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
465 thread_TSO (StgTSO *tso)
467 thread_(&tso->_link);
468 thread_(&tso->global_link);
470 if ( tso->why_blocked == BlockedOnMVar
471 || tso->why_blocked == BlockedOnBlackHole
472 || tso->why_blocked == BlockedOnException
474 thread_(&tso->block_info.closure);
476 thread_(&tso->blocked_exceptions);
480 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
481 return (StgPtr)tso + tso_sizeW(tso);
486 update_fwd_large( bdescr *bd )
489 const StgInfoTable* info;
491 for (; bd != NULL; bd = bd->link) {
493 // nothing to do in a pinned block; it might not even have an object
495 if (bd->flags & BF_PINNED) continue;
498 info = get_itbl((StgClosure *)p);
500 switch (info->type) {
506 case MUT_ARR_PTRS_CLEAN:
507 case MUT_ARR_PTRS_DIRTY:
508 case MUT_ARR_PTRS_FROZEN:
509 case MUT_ARR_PTRS_FROZEN0:
514 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
515 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
516 thread((StgClosure **)p);
522 thread_TSO((StgTSO *)p);
526 thread_AP_STACK((StgAP_STACK *)p);
530 thread_PAP((StgPAP *)p);
536 StgTRecChunk *tc = (StgTRecChunk *)p;
537 TRecEntry *e = &(tc -> entries[0]);
538 thread_(&tc->prev_chunk);
539 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
541 thread(&e->expected_value);
542 thread(&e->new_value);
548 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
553 // ToDo: too big to inline
554 static /* STATIC_INLINE */ StgPtr
555 thread_obj (StgInfoTable *info, StgPtr p)
557 switch (info->type) {
559 return p + sizeofW(StgThunk) + 1;
563 return p + sizeofW(StgHeader) + 1;
567 thread(&((StgClosure *)p)->payload[0]);
568 return p + sizeofW(StgHeader) + 1;
571 thread(&((StgThunk *)p)->payload[0]);
572 return p + sizeofW(StgThunk) + 1;
575 return p + sizeofW(StgThunk) + 2;
579 return p + sizeofW(StgHeader) + 2;
582 thread(&((StgThunk *)p)->payload[0]);
583 return p + sizeofW(StgThunk) + 2;
587 thread(&((StgClosure *)p)->payload[0]);
588 return p + sizeofW(StgHeader) + 2;
591 thread(&((StgThunk *)p)->payload[0]);
592 thread(&((StgThunk *)p)->payload[1]);
593 return p + sizeofW(StgThunk) + 2;
597 thread(&((StgClosure *)p)->payload[0]);
598 thread(&((StgClosure *)p)->payload[1]);
599 return p + sizeofW(StgHeader) + 2;
602 StgBCO *bco = (StgBCO *)p;
603 thread_(&bco->instrs);
604 thread_(&bco->literals);
606 return p + bco_sizeW(bco);
613 end = (P_)((StgThunk *)p)->payload +
614 info->layout.payload.ptrs;
615 for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
616 thread((StgClosure **)p);
618 return p + info->layout.payload.nptrs;
632 end = (P_)((StgClosure *)p)->payload +
633 info->layout.payload.ptrs;
634 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
635 thread((StgClosure **)p);
637 return p + info->layout.payload.nptrs;
642 StgWeak *w = (StgWeak *)p;
645 thread(&w->finalizer);
646 if (w->link != NULL) {
649 return p + sizeofW(StgWeak);
655 StgMVar *mvar = (StgMVar *)p;
656 thread_(&mvar->head);
657 thread_(&mvar->tail);
658 thread(&mvar->value);
659 return p + sizeofW(StgMVar);
663 case IND_OLDGEN_PERM:
664 thread(&((StgInd *)p)->indirectee);
665 return p + sizeofW(StgInd);
669 StgSelector *s = (StgSelector *)p;
670 thread(&s->selectee);
671 return p + THUNK_SELECTOR_sizeW();
675 return thread_AP_STACK((StgAP_STACK *)p);
678 return thread_PAP((StgPAP *)p);
681 return thread_AP((StgAP *)p);
684 return p + arr_words_sizeW((StgArrWords *)p);
686 case MUT_ARR_PTRS_CLEAN:
687 case MUT_ARR_PTRS_DIRTY:
688 case MUT_ARR_PTRS_FROZEN:
689 case MUT_ARR_PTRS_FROZEN0:
694 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
695 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
696 thread((StgClosure **)p);
702 return thread_TSO((StgTSO *)p);
704 case TVAR_WATCH_QUEUE:
706 StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p;
707 thread_(&wq->closure);
708 thread_(&wq->next_queue_entry);
709 thread_(&wq->prev_queue_entry);
710 return p + sizeofW(StgTVarWatchQueue);
715 StgTVar *tvar = (StgTVar *)p;
716 thread((void *)&tvar->current_value);
717 thread((void *)&tvar->first_watch_queue_entry);
718 return p + sizeofW(StgTVar);
723 StgTRecHeader *trec = (StgTRecHeader *)p;
724 thread_(&trec->enclosing_trec);
725 thread_(&trec->current_chunk);
726 thread_(&trec->invariants_to_check);
727 return p + sizeofW(StgTRecHeader);
733 StgTRecChunk *tc = (StgTRecChunk *)p;
734 TRecEntry *e = &(tc -> entries[0]);
735 thread_(&tc->prev_chunk);
736 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
738 thread(&e->expected_value);
739 thread(&e->new_value);
741 return p + sizeofW(StgTRecChunk);
744 case ATOMIC_INVARIANT:
746 StgAtomicInvariant *invariant = (StgAtomicInvariant *)p;
747 thread_(&invariant->code);
748 thread_(&invariant->last_execution);
749 return p + sizeofW(StgAtomicInvariant);
752 case INVARIANT_CHECK_QUEUE:
754 StgInvariantCheckQueue *queue = (StgInvariantCheckQueue *)p;
755 thread_(&queue->invariant);
756 thread_(&queue->my_execution);
757 thread_(&queue->next_queue_entry);
758 return p + sizeofW(StgInvariantCheckQueue);
762 barf("update_fwd: unknown/strange object %d", (int)(info->type));
768 update_fwd( bdescr *blocks )
776 // cycle through all the blocks in the step
777 for (; bd != NULL; bd = bd->link) {
780 // linearly scan the objects in this block
781 while (p < bd->free) {
782 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
783 info = get_itbl((StgClosure *)p);
784 p = thread_obj(info, p);
790 update_fwd_compact( bdescr *blocks )
796 bdescr *bd, *free_bd;
803 free = free_bd->start;
805 // cycle through all the blocks in the step
806 for (; bd != NULL; bd = bd->link) {
809 while (p < bd->free ) {
811 while ( p < bd->free && !is_marked(p,bd) ) {
820 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
821 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
823 while ( p < bd->free ) {
828 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
836 // Problem: we need to know the destination for this cell
837 // in order to unthread its info pointer. But we can't
838 // know the destination without the size, because we may
839 // spill into the next block. So we have to run down the
840 // threaded list and get the info ptr first.
842 // ToDo: one possible avenue of attack is to use the fact
843 // that if (p&BLOCK_MASK) >= (free&BLOCK_MASK), then we
844 // definitely have enough room. Also see bug #1147.
845 iptr = get_threaded_info(p);
846 info = INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)iptr));
850 p = thread_obj(info, p);
853 if (free + size > free_bd->start + BLOCK_SIZE_W) {
854 // unset the next bit in the bitmap to indicate that
855 // this object needs to be pushed into the next
856 // block. This saves us having to run down the
857 // threaded info pointer list twice during the next pass.
859 free_bd = free_bd->link;
860 free = free_bd->start;
862 ASSERT(is_marked(q+1,bd));
865 unthread(q,(StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
875 update_bkwd_compact( step *stp )
881 bdescr *bd, *free_bd;
883 nat size, free_blocks;
886 bd = free_bd = stp->old_blocks;
887 free = free_bd->start;
890 // cycle through all the blocks in the step
891 for (; bd != NULL; bd = bd->link) {
894 while (p < bd->free ) {
896 while ( p < bd->free && !is_marked(p,bd) ) {
905 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
906 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
908 while ( p < bd->free ) {
913 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
921 if (!is_marked(p+1,bd)) {
922 // don't forget to update the free ptr in the block desc.
923 free_bd->free = free;
924 free_bd = free_bd->link;
925 free = free_bd->start;
929 iptr = get_threaded_info(p);
930 unthread(p, (StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
931 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
932 info = get_itbl((StgClosure *)p);
933 size = closure_sizeW_((StgClosure *)p,info);
940 if (info->type == TSO) {
941 move_TSO((StgTSO *)p, (StgTSO *)free);
952 // free the remaining blocks and count what's left.
953 free_bd->free = free;
954 if (free_bd->link != NULL) {
955 freeChain(free_bd->link);
956 free_bd->link = NULL;
963 compact(StgClosure *static_objects)
968 // 1. thread the roots
969 markCapabilities((evac_fn)thread_root, NULL);
971 // the weak pointer lists...
972 if (weak_ptr_list != NULL) {
973 thread((void *)&weak_ptr_list);
975 if (old_weak_ptr_list != NULL) {
976 thread((void *)&old_weak_ptr_list); // tmp
980 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
984 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
985 for (p = bd->start; p < bd->free; p++) {
986 thread((StgClosure **)p);
989 for (n = 0; n < n_capabilities; n++) {
990 for (bd = capabilities[n].mut_lists[g];
991 bd != NULL; bd = bd->link) {
992 for (p = bd->start; p < bd->free; p++) {
993 thread((StgClosure **)p);
999 // the global thread list
1000 for (s = 0; s < total_steps; s++) {
1001 thread((void *)&all_steps[s].threads);
1004 // any threads resurrected during this GC
1005 thread((void *)&resurrected_threads);
1007 // the blackhole queue
1008 thread((void *)&blackhole_queue);
1013 for (task = all_tasks; task != NULL; task = task->all_link) {
1015 thread_(&task->tso);
1020 // the static objects
1021 thread_static(static_objects /* ToDo: ok? */);
1023 // the stable pointer table
1024 threadStablePtrTable((evac_fn)thread_root, NULL);
1026 // the CAF list (used by GHCi)
1027 markCAFs((evac_fn)thread_root, NULL);
1029 // 2. update forward ptrs
1030 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1031 for (s = 0; s < generations[g].n_steps; s++) {
1032 if (g==0 && s ==0) continue;
1033 stp = &generations[g].steps[s];
1034 debugTrace(DEBUG_gc, "update_fwd: %d.%d",
1035 stp->gen->no, stp->no);
1037 update_fwd(stp->blocks);
1038 update_fwd_large(stp->scavenged_large_objects);
1039 if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
1040 debugTrace(DEBUG_gc, "update_fwd: %d.%d (compact)",
1041 stp->gen->no, stp->no);
1042 update_fwd_compact(stp->old_blocks);
1047 // 3. update backward ptrs
1048 stp = &oldest_gen->steps[0];
1049 if (stp->old_blocks != NULL) {
1050 blocks = update_bkwd_compact(stp);
1051 debugTrace(DEBUG_gc,
1052 "update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)",
1053 stp->gen->no, stp->no,
1054 stp->n_old_blocks, blocks);
1055 stp->n_old_blocks = blocks;