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 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)) {
86 // a handy way to discover whether the ptr is into the
87 // compacted area of the old gen, is that the EVACUATED flag
88 // is zero (it's non-zero for all the other areas of live
90 if ((bd->flags & BF_EVACUATED) == 0)
93 switch (GET_CLOSURE_TAG((StgClosure *)iptr))
96 // this is the info pointer; we are creating a new chain.
97 // save the original tag at the end of the chain.
98 *p = (StgClosure *)((StgWord)iptr + GET_CLOSURE_TAG(q0));
103 // this is a chain of length 1 or more
104 *p = (StgClosure *)iptr;
113 thread_root (void *user STG_UNUSED, StgClosure **p)
118 // This version of thread() takes a (void *), used to circumvent
119 // warnings from gcc about pointer punning and strict aliasing.
120 STATIC_INLINE void thread_ (void *p) { thread((StgClosure **)p); }
123 unthread( StgPtr p, StgWord free )
130 switch (GET_CLOSURE_TAG((StgClosure *)q))
133 // nothing to do; the chain is length zero
137 r = *q0; // r is the info ptr, tagged with the pointer-tag
139 *p = (StgWord)UNTAG_CLOSURE((StgClosure *)r);
152 // Traverse a threaded chain and pull out the info pointer at the end.
153 // The info pointer is also tagged with the appropriate pointer tag
154 // for this closure, which should be attached to the pointer
155 // subsequently passed to unthread().
156 STATIC_INLINE StgWord
157 get_threaded_info( StgPtr p )
161 q = (W_)GET_INFO(UNTAG_CLOSURE((StgClosure *)p));
164 switch (GET_CLOSURE_TAG((StgClosure *)q))
167 ASSERT(LOOKS_LIKE_INFO_PTR(q));
171 StgWord r = *(StgPtr)(q-1);
172 ASSERT(LOOKS_LIKE_INFO_PTR(UNTAG_CLOSURE((StgClosure *)r)));
179 barf("get_threaded_info");
183 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
184 // Remember, the two regions *might* overlap, but: to <= from.
186 move(StgPtr to, StgPtr from, nat size)
188 for(; size > 0; --size) {
194 thread_static( StgClosure* p )
196 const StgInfoTable *info;
198 // keep going until we've threaded all the objects on the linked
200 while (p != END_OF_STATIC_LIST) {
203 switch (info->type) {
206 thread(&((StgInd *)p)->indirectee);
207 p = *IND_STATIC_LINK(p);
211 p = *THUNK_STATIC_LINK(p);
214 p = *FUN_STATIC_LINK(p);
217 p = *STATIC_LINK(info,p);
221 barf("thread_static: strange closure %d", (int)(info->type));
228 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
234 bitmap = large_bitmap->bitmap[b];
235 for (i = 0; i < size; ) {
236 if ((bitmap & 1) == 0) {
237 thread((StgClosure **)p);
241 if (i % BITS_IN(W_) == 0) {
243 bitmap = large_bitmap->bitmap[b];
245 bitmap = bitmap >> 1;
251 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
258 switch (fun_info->f.fun_type) {
260 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
261 size = BITMAP_SIZE(fun_info->f.b.bitmap);
264 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
265 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
269 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
270 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
273 if ((bitmap & 1) == 0) {
274 thread((StgClosure **)p);
277 bitmap = bitmap >> 1;
286 thread_stack(StgPtr p, StgPtr stack_end)
288 const StgRetInfoTable* info;
292 // highly similar to scavenge_stack, but we do pointer threading here.
294 while (p < stack_end) {
296 // *p must be the info pointer of an activation
297 // record. All activation records have 'bitmap' style layout
300 info = get_ret_itbl((StgClosure *)p);
302 switch (info->i.type) {
304 // Dynamic bitmap: the mask is stored on the stack
308 dyn = ((StgRetDyn *)p)->liveness;
310 // traverse the bitmap first
311 bitmap = RET_DYN_LIVENESS(dyn);
312 p = (P_)&((StgRetDyn *)p)->payload[0];
313 size = RET_DYN_BITMAP_SIZE;
315 if ((bitmap & 1) == 0) {
316 thread((StgClosure **)p);
319 bitmap = bitmap >> 1;
323 // skip over the non-ptr words
324 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
326 // follow the ptr words
327 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
328 thread((StgClosure **)p);
334 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
335 case CATCH_RETRY_FRAME:
336 case CATCH_STM_FRAME:
337 case ATOMICALLY_FRAME:
342 bitmap = BITMAP_BITS(info->i.layout.bitmap);
343 size = BITMAP_SIZE(info->i.layout.bitmap);
345 // NOTE: the payload starts immediately after the info-ptr, we
346 // don't have an StgHeader in the same sense as a heap closure.
348 if ((bitmap & 1) == 0) {
349 thread((StgClosure **)p);
352 bitmap = bitmap >> 1;
363 thread((StgClosure **)p);
365 size = BCO_BITMAP_SIZE(bco);
366 thread_large_bitmap(p, BCO_BITMAP(bco), size);
371 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
374 size = GET_LARGE_BITMAP(&info->i)->size;
375 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
381 StgRetFun *ret_fun = (StgRetFun *)p;
382 StgFunInfoTable *fun_info;
384 fun_info = FUN_INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)
385 get_threaded_info((StgPtr)ret_fun->fun)));
386 // *before* threading it!
387 thread(&ret_fun->fun);
388 p = thread_arg_block(fun_info, ret_fun->payload);
393 barf("thread_stack: weird activation record found on stack: %d",
394 (int)(info->i.type));
400 thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
404 StgFunInfoTable *fun_info;
406 fun_info = FUN_INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)
407 get_threaded_info((StgPtr)fun)));
408 ASSERT(fun_info->i.type != PAP);
412 switch (fun_info->f.fun_type) {
414 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
417 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
421 thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
425 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
428 if ((bitmap & 1) == 0) {
429 thread((StgClosure **)p);
432 bitmap = bitmap >> 1;
442 thread_PAP (StgPAP *pap)
445 p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
451 thread_AP (StgAP *ap)
454 p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
460 thread_AP_STACK (StgAP_STACK *ap)
463 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
464 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
468 thread_TSO (StgTSO *tso)
471 thread_(&tso->global_link);
473 if ( tso->why_blocked == BlockedOnMVar
474 || tso->why_blocked == BlockedOnBlackHole
475 || tso->why_blocked == BlockedOnException
477 thread_(&tso->block_info.closure);
479 thread_(&tso->blocked_exceptions);
483 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
484 return (StgPtr)tso + tso_sizeW(tso);
489 update_fwd_large( bdescr *bd )
492 const StgInfoTable* info;
494 for (; bd != NULL; bd = bd->link) {
497 info = get_itbl((StgClosure *)p);
499 switch (info->type) {
505 case MUT_ARR_PTRS_CLEAN:
506 case MUT_ARR_PTRS_DIRTY:
507 case MUT_ARR_PTRS_FROZEN:
508 case MUT_ARR_PTRS_FROZEN0:
513 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
514 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
515 thread((StgClosure **)p);
521 thread_TSO((StgTSO *)p);
525 thread_AP_STACK((StgAP_STACK *)p);
529 thread_PAP((StgPAP *)p);
535 StgTRecChunk *tc = (StgTRecChunk *)p;
536 TRecEntry *e = &(tc -> entries[0]);
537 thread_(&tc->prev_chunk);
538 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
540 thread(&e->expected_value);
541 thread(&e->new_value);
547 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
552 // ToDo: too big to inline
553 static /* STATIC_INLINE */ StgPtr
554 thread_obj (StgInfoTable *info, StgPtr p)
556 switch (info->type) {
558 return p + sizeofW(StgThunk) + 1;
562 return p + sizeofW(StgHeader) + 1;
566 thread(&((StgClosure *)p)->payload[0]);
567 return p + sizeofW(StgHeader) + 1;
570 thread(&((StgThunk *)p)->payload[0]);
571 return p + sizeofW(StgThunk) + 1;
574 return p + sizeofW(StgThunk) + 2;
578 return p + sizeofW(StgHeader) + 2;
581 thread(&((StgThunk *)p)->payload[0]);
582 return p + sizeofW(StgThunk) + 2;
586 thread(&((StgClosure *)p)->payload[0]);
587 return p + sizeofW(StgHeader) + 2;
590 thread(&((StgThunk *)p)->payload[0]);
591 thread(&((StgThunk *)p)->payload[1]);
592 return p + sizeofW(StgThunk) + 2;
596 thread(&((StgClosure *)p)->payload[0]);
597 thread(&((StgClosure *)p)->payload[1]);
598 return p + sizeofW(StgHeader) + 2;
601 StgBCO *bco = (StgBCO *)p;
602 thread_(&bco->instrs);
603 thread_(&bco->literals);
605 return p + bco_sizeW(bco);
612 end = (P_)((StgThunk *)p)->payload +
613 info->layout.payload.ptrs;
614 for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
615 thread((StgClosure **)p);
617 return p + info->layout.payload.nptrs;
627 case SE_CAF_BLACKHOLE:
633 end = (P_)((StgClosure *)p)->payload +
634 info->layout.payload.ptrs;
635 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
636 thread((StgClosure **)p);
638 return p + info->layout.payload.nptrs;
643 StgWeak *w = (StgWeak *)p;
646 thread(&w->finalizer);
647 if (w->link != NULL) {
650 return p + sizeofW(StgWeak);
656 StgMVar *mvar = (StgMVar *)p;
657 thread_(&mvar->head);
658 thread_(&mvar->tail);
659 thread(&mvar->value);
660 return p + sizeofW(StgMVar);
664 case IND_OLDGEN_PERM:
665 thread(&((StgInd *)p)->indirectee);
666 return p + sizeofW(StgInd);
670 StgSelector *s = (StgSelector *)p;
671 thread(&s->selectee);
672 return p + THUNK_SELECTOR_sizeW();
676 return thread_AP_STACK((StgAP_STACK *)p);
679 return thread_PAP((StgPAP *)p);
682 return thread_AP((StgAP *)p);
685 return p + arr_words_sizeW((StgArrWords *)p);
687 case MUT_ARR_PTRS_CLEAN:
688 case MUT_ARR_PTRS_DIRTY:
689 case MUT_ARR_PTRS_FROZEN:
690 case MUT_ARR_PTRS_FROZEN0:
695 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
696 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
697 thread((StgClosure **)p);
703 return thread_TSO((StgTSO *)p);
705 case TVAR_WATCH_QUEUE:
707 StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p;
708 thread_(&wq->closure);
709 thread_(&wq->next_queue_entry);
710 thread_(&wq->prev_queue_entry);
711 return p + sizeofW(StgTVarWatchQueue);
716 StgTVar *tvar = (StgTVar *)p;
717 thread((void *)&tvar->current_value);
718 thread((void *)&tvar->first_watch_queue_entry);
719 return p + sizeofW(StgTVar);
724 StgTRecHeader *trec = (StgTRecHeader *)p;
725 thread_(&trec->enclosing_trec);
726 thread_(&trec->current_chunk);
727 thread_(&trec->invariants_to_check);
728 return p + sizeofW(StgTRecHeader);
734 StgTRecChunk *tc = (StgTRecChunk *)p;
735 TRecEntry *e = &(tc -> entries[0]);
736 thread_(&tc->prev_chunk);
737 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
739 thread(&e->expected_value);
740 thread(&e->new_value);
742 return p + sizeofW(StgTRecChunk);
745 case ATOMIC_INVARIANT:
747 StgAtomicInvariant *invariant = (StgAtomicInvariant *)p;
748 thread_(&invariant->code);
749 thread_(&invariant->last_execution);
750 return p + sizeofW(StgAtomicInvariant);
753 case INVARIANT_CHECK_QUEUE:
755 StgInvariantCheckQueue *queue = (StgInvariantCheckQueue *)p;
756 thread_(&queue->invariant);
757 thread_(&queue->my_execution);
758 thread_(&queue->next_queue_entry);
759 return p + sizeofW(StgInvariantCheckQueue);
763 barf("update_fwd: unknown/strange object %d", (int)(info->type));
769 update_fwd( bdescr *blocks )
777 // cycle through all the blocks in the step
778 for (; bd != NULL; bd = bd->link) {
781 // linearly scan the objects in this block
782 while (p < bd->free) {
783 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
784 info = get_itbl((StgClosure *)p);
785 p = thread_obj(info, p);
791 update_fwd_compact( bdescr *blocks )
797 bdescr *bd, *free_bd;
804 free = free_bd->start;
806 // cycle through all the blocks in the step
807 for (; bd != NULL; bd = bd->link) {
810 while (p < bd->free ) {
812 while ( p < bd->free && !is_marked(p,bd) ) {
821 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
822 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
824 while ( p < bd->free ) {
829 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
837 // Problem: we need to know the destination for this cell
838 // in order to unthread its info pointer. But we can't
839 // know the destination without the size, because we may
840 // spill into the next block. So we have to run down the
841 // threaded list and get the info ptr first.
843 // ToDo: one possible avenue of attack is to use the fact
844 // that if (p&BLOCK_MASK) >= (free&BLOCK_MASK), then we
845 // definitely have enough room. Also see bug #1147.
846 iptr = get_threaded_info(p);
847 info = INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)iptr));
851 p = thread_obj(info, p);
854 if (free + size > free_bd->start + BLOCK_SIZE_W) {
855 // unset the next bit in the bitmap to indicate that
856 // this object needs to be pushed into the next
857 // block. This saves us having to run down the
858 // threaded info pointer list twice during the next pass.
860 free_bd = free_bd->link;
861 free = free_bd->start;
863 ASSERT(is_marked(q+1,bd));
866 unthread(q,(StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
876 update_bkwd_compact( step *stp )
882 bdescr *bd, *free_bd;
884 nat size, free_blocks;
887 bd = free_bd = stp->old_blocks;
888 free = free_bd->start;
891 // cycle through all the blocks in the step
892 for (; bd != NULL; bd = bd->link) {
895 while (p < bd->free ) {
897 while ( p < bd->free && !is_marked(p,bd) ) {
906 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
907 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
909 while ( p < bd->free ) {
914 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
922 if (!is_marked(p+1,bd)) {
923 // don't forget to update the free ptr in the block desc.
924 free_bd->free = free;
925 free_bd = free_bd->link;
926 free = free_bd->start;
930 iptr = get_threaded_info(p);
931 unthread(p, (StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
932 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
933 info = get_itbl((StgClosure *)p);
934 size = closure_sizeW_((StgClosure *)p,info);
941 if (info->type == TSO) {
942 move_TSO((StgTSO *)p, (StgTSO *)free);
953 // free the remaining blocks and count what's left.
954 free_bd->free = free;
955 if (free_bd->link != NULL) {
956 freeChain(free_bd->link);
957 free_bd->link = NULL;
964 compact(StgClosure *static_objects)
969 // 1. thread the roots
970 markCapabilities((evac_fn)thread_root, NULL);
972 // the weak pointer lists...
973 if (weak_ptr_list != NULL) {
974 thread((void *)&weak_ptr_list);
976 if (old_weak_ptr_list != NULL) {
977 thread((void *)&old_weak_ptr_list); // tmp
981 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);
991 // the global thread list
992 thread((void *)&all_threads);
994 // any threads resurrected during this GC
995 thread((void *)&resurrected_threads);
1000 for (task = all_tasks; task != NULL; task = task->all_link) {
1002 thread_(&task->tso);
1007 // the static objects
1008 thread_static(static_objects /* ToDo: ok? */);
1010 // the stable pointer table
1011 threadStablePtrTable((evac_fn)thread_root, NULL);
1013 // the CAF list (used by GHCi)
1014 markCAFs((evac_fn)thread_root, NULL);
1016 // 2. update forward ptrs
1017 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1018 for (s = 0; s < generations[g].n_steps; s++) {
1019 if (g==0 && s ==0) continue;
1020 stp = &generations[g].steps[s];
1021 debugTrace(DEBUG_gc, "update_fwd: %d.%d",
1022 stp->gen->no, stp->no);
1024 update_fwd(stp->blocks);
1025 update_fwd_large(stp->scavenged_large_objects);
1026 if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
1027 debugTrace(DEBUG_gc, "update_fwd: %d.%d (compact)",
1028 stp->gen->no, stp->no);
1029 update_fwd_compact(stp->old_blocks);
1034 // 3. update backward ptrs
1035 stp = &oldest_gen->steps[0];
1036 if (stp->old_blocks != NULL) {
1037 blocks = update_bkwd_compact(stp);
1038 debugTrace(DEBUG_gc,
1039 "update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)",
1040 stp->gen->no, stp->no,
1041 stp->n_old_blocks, blocks);
1042 stp->n_old_blocks = blocks;