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;
112 // This version of thread() takes a (void *), used to circumvent
113 // warnings from gcc about pointer punning and strict aliasing.
114 STATIC_INLINE void thread_ (void *p) { thread((StgClosure **)p); }
117 unthread( StgPtr p, StgWord free )
124 switch (GET_CLOSURE_TAG((StgClosure *)q))
127 // nothing to do; the chain is length zero
131 r = *q0; // r is the info ptr, tagged with the pointer-tag
133 *p = (StgWord)UNTAG_CLOSURE((StgClosure *)r);
146 // Traverse a threaded chain and pull out the info pointer at the end.
147 // The info pointer is also tagged with the appropriate pointer tag
148 // for this closure, which should be attached to the pointer
149 // subsequently passed to unthread().
150 STATIC_INLINE StgWord
151 get_threaded_info( StgPtr p )
155 q = (W_)GET_INFO(UNTAG_CLOSURE((StgClosure *)p));
158 switch (GET_CLOSURE_TAG((StgClosure *)q))
161 ASSERT(LOOKS_LIKE_INFO_PTR(q));
165 StgWord r = *(StgPtr)(q-1);
166 ASSERT(LOOKS_LIKE_INFO_PTR(UNTAG_CLOSURE((StgClosure *)r)));
173 barf("get_threaded_info");
177 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
178 // Remember, the two regions *might* overlap, but: to <= from.
180 move(StgPtr to, StgPtr from, nat size)
182 for(; size > 0; --size) {
188 thread_static( StgClosure* p )
190 const StgInfoTable *info;
192 // keep going until we've threaded all the objects on the linked
194 while (p != END_OF_STATIC_LIST) {
197 switch (info->type) {
200 thread(&((StgInd *)p)->indirectee);
201 p = *IND_STATIC_LINK(p);
205 p = *THUNK_STATIC_LINK(p);
208 p = *FUN_STATIC_LINK(p);
211 p = *STATIC_LINK(info,p);
215 barf("thread_static: strange closure %d", (int)(info->type));
222 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
228 bitmap = large_bitmap->bitmap[b];
229 for (i = 0; i < size; ) {
230 if ((bitmap & 1) == 0) {
231 thread((StgClosure **)p);
235 if (i % BITS_IN(W_) == 0) {
237 bitmap = large_bitmap->bitmap[b];
239 bitmap = bitmap >> 1;
245 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
252 switch (fun_info->f.fun_type) {
254 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
255 size = BITMAP_SIZE(fun_info->f.b.bitmap);
258 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
259 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
263 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
264 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
267 if ((bitmap & 1) == 0) {
268 thread((StgClosure **)p);
271 bitmap = bitmap >> 1;
280 thread_stack(StgPtr p, StgPtr stack_end)
282 const StgRetInfoTable* info;
286 // highly similar to scavenge_stack, but we do pointer threading here.
288 while (p < stack_end) {
290 // *p must be the info pointer of an activation
291 // record. All activation records have 'bitmap' style layout
294 info = get_ret_itbl((StgClosure *)p);
296 switch (info->i.type) {
298 // Dynamic bitmap: the mask is stored on the stack
302 dyn = ((StgRetDyn *)p)->liveness;
304 // traverse the bitmap first
305 bitmap = RET_DYN_LIVENESS(dyn);
306 p = (P_)&((StgRetDyn *)p)->payload[0];
307 size = RET_DYN_BITMAP_SIZE;
309 if ((bitmap & 1) == 0) {
310 thread((StgClosure **)p);
313 bitmap = bitmap >> 1;
317 // skip over the non-ptr words
318 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
320 // follow the ptr words
321 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
322 thread((StgClosure **)p);
328 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
329 case CATCH_RETRY_FRAME:
330 case CATCH_STM_FRAME:
331 case ATOMICALLY_FRAME:
336 bitmap = BITMAP_BITS(info->i.layout.bitmap);
337 size = BITMAP_SIZE(info->i.layout.bitmap);
339 // NOTE: the payload starts immediately after the info-ptr, we
340 // don't have an StgHeader in the same sense as a heap closure.
342 if ((bitmap & 1) == 0) {
343 thread((StgClosure **)p);
346 bitmap = bitmap >> 1;
357 thread((StgClosure **)p);
359 size = BCO_BITMAP_SIZE(bco);
360 thread_large_bitmap(p, BCO_BITMAP(bco), size);
365 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
368 size = GET_LARGE_BITMAP(&info->i)->size;
369 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
375 StgRetFun *ret_fun = (StgRetFun *)p;
376 StgFunInfoTable *fun_info;
378 fun_info = FUN_INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)
379 get_threaded_info((StgPtr)ret_fun->fun)));
380 // *before* threading it!
381 thread(&ret_fun->fun);
382 p = thread_arg_block(fun_info, ret_fun->payload);
387 barf("thread_stack: weird activation record found on stack: %d",
388 (int)(info->i.type));
394 thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
398 StgFunInfoTable *fun_info;
400 fun_info = FUN_INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)
401 get_threaded_info((StgPtr)fun)));
402 ASSERT(fun_info->i.type != PAP);
406 switch (fun_info->f.fun_type) {
408 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
411 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
415 thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
419 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
422 if ((bitmap & 1) == 0) {
423 thread((StgClosure **)p);
426 bitmap = bitmap >> 1;
436 thread_PAP (StgPAP *pap)
439 p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
445 thread_AP (StgAP *ap)
448 p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
454 thread_AP_STACK (StgAP_STACK *ap)
457 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
458 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
462 thread_TSO (StgTSO *tso)
465 thread_(&tso->global_link);
467 if ( tso->why_blocked == BlockedOnMVar
468 || tso->why_blocked == BlockedOnBlackHole
469 || tso->why_blocked == BlockedOnException
471 thread_(&tso->block_info.closure);
473 thread_(&tso->blocked_exceptions);
477 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
478 return (StgPtr)tso + tso_sizeW(tso);
483 update_fwd_large( bdescr *bd )
486 const StgInfoTable* info;
488 for (; bd != NULL; bd = bd->link) {
491 info = get_itbl((StgClosure *)p);
493 switch (info->type) {
499 case MUT_ARR_PTRS_CLEAN:
500 case MUT_ARR_PTRS_DIRTY:
501 case MUT_ARR_PTRS_FROZEN:
502 case MUT_ARR_PTRS_FROZEN0:
507 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
508 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
509 thread((StgClosure **)p);
515 thread_TSO((StgTSO *)p);
519 thread_AP_STACK((StgAP_STACK *)p);
523 thread_PAP((StgPAP *)p);
529 StgTRecChunk *tc = (StgTRecChunk *)p;
530 TRecEntry *e = &(tc -> entries[0]);
531 thread_(&tc->prev_chunk);
532 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
534 thread(&e->expected_value);
535 thread(&e->new_value);
541 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
546 // ToDo: too big to inline
547 static /* STATIC_INLINE */ StgPtr
548 thread_obj (StgInfoTable *info, StgPtr p)
550 switch (info->type) {
552 return p + sizeofW(StgThunk) + 1;
556 return p + sizeofW(StgHeader) + 1;
560 thread(&((StgClosure *)p)->payload[0]);
561 return p + sizeofW(StgHeader) + 1;
564 thread(&((StgThunk *)p)->payload[0]);
565 return p + sizeofW(StgThunk) + 1;
568 return p + sizeofW(StgThunk) + 2;
572 return p + sizeofW(StgHeader) + 2;
575 thread(&((StgThunk *)p)->payload[0]);
576 return p + sizeofW(StgThunk) + 2;
580 thread(&((StgClosure *)p)->payload[0]);
581 return p + sizeofW(StgHeader) + 2;
584 thread(&((StgThunk *)p)->payload[0]);
585 thread(&((StgThunk *)p)->payload[1]);
586 return p + sizeofW(StgThunk) + 2;
590 thread(&((StgClosure *)p)->payload[0]);
591 thread(&((StgClosure *)p)->payload[1]);
592 return p + sizeofW(StgHeader) + 2;
595 StgBCO *bco = (StgBCO *)p;
596 thread_(&bco->instrs);
597 thread_(&bco->literals);
599 return p + bco_sizeW(bco);
606 end = (P_)((StgThunk *)p)->payload +
607 info->layout.payload.ptrs;
608 for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
609 thread((StgClosure **)p);
611 return p + info->layout.payload.nptrs;
621 case SE_CAF_BLACKHOLE:
627 end = (P_)((StgClosure *)p)->payload +
628 info->layout.payload.ptrs;
629 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
630 thread((StgClosure **)p);
632 return p + info->layout.payload.nptrs;
637 StgWeak *w = (StgWeak *)p;
640 thread(&w->finalizer);
641 if (w->link != NULL) {
644 return p + sizeofW(StgWeak);
649 StgMVar *mvar = (StgMVar *)p;
650 thread_(&mvar->head);
651 thread_(&mvar->tail);
652 thread(&mvar->value);
653 return p + sizeofW(StgMVar);
657 case IND_OLDGEN_PERM:
658 thread(&((StgInd *)p)->indirectee);
659 return p + sizeofW(StgInd);
663 StgSelector *s = (StgSelector *)p;
664 thread(&s->selectee);
665 return p + THUNK_SELECTOR_sizeW();
669 return thread_AP_STACK((StgAP_STACK *)p);
672 return thread_PAP((StgPAP *)p);
675 return thread_AP((StgAP *)p);
678 return p + arr_words_sizeW((StgArrWords *)p);
680 case MUT_ARR_PTRS_CLEAN:
681 case MUT_ARR_PTRS_DIRTY:
682 case MUT_ARR_PTRS_FROZEN:
683 case MUT_ARR_PTRS_FROZEN0:
688 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
689 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
690 thread((StgClosure **)p);
696 return thread_TSO((StgTSO *)p);
698 case TVAR_WATCH_QUEUE:
700 StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p;
701 thread_(&wq->closure);
702 thread_(&wq->next_queue_entry);
703 thread_(&wq->prev_queue_entry);
704 return p + sizeofW(StgTVarWatchQueue);
709 StgTVar *tvar = (StgTVar *)p;
710 thread((void *)&tvar->current_value);
711 thread((void *)&tvar->first_watch_queue_entry);
712 return p + sizeofW(StgTVar);
717 StgTRecHeader *trec = (StgTRecHeader *)p;
718 thread_(&trec->enclosing_trec);
719 thread_(&trec->current_chunk);
720 thread_(&trec->invariants_to_check);
721 return p + sizeofW(StgTRecHeader);
727 StgTRecChunk *tc = (StgTRecChunk *)p;
728 TRecEntry *e = &(tc -> entries[0]);
729 thread_(&tc->prev_chunk);
730 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
732 thread(&e->expected_value);
733 thread(&e->new_value);
735 return p + sizeofW(StgTRecChunk);
738 case ATOMIC_INVARIANT:
740 StgAtomicInvariant *invariant = (StgAtomicInvariant *)p;
741 thread_(&invariant->code);
742 thread_(&invariant->last_execution);
743 return p + sizeofW(StgAtomicInvariant);
746 case INVARIANT_CHECK_QUEUE:
748 StgInvariantCheckQueue *queue = (StgInvariantCheckQueue *)p;
749 thread_(&queue->invariant);
750 thread_(&queue->my_execution);
751 thread_(&queue->next_queue_entry);
752 return p + sizeofW(StgInvariantCheckQueue);
756 barf("update_fwd: unknown/strange object %d", (int)(info->type));
762 update_fwd( bdescr *blocks )
770 // cycle through all the blocks in the step
771 for (; bd != NULL; bd = bd->link) {
774 // linearly scan the objects in this block
775 while (p < bd->free) {
776 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
777 info = get_itbl((StgClosure *)p);
778 p = thread_obj(info, p);
784 update_fwd_compact( bdescr *blocks )
790 bdescr *bd, *free_bd;
797 free = free_bd->start;
799 // cycle through all the blocks in the step
800 for (; bd != NULL; bd = bd->link) {
803 while (p < bd->free ) {
805 while ( p < bd->free && !is_marked(p,bd) ) {
814 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
815 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
817 while ( p < bd->free ) {
822 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
830 // Problem: we need to know the destination for this cell
831 // in order to unthread its info pointer. But we can't
832 // know the destination without the size, because we may
833 // spill into the next block. So we have to run down the
834 // threaded list and get the info ptr first.
836 // ToDo: one possible avenue of attack is to use the fact
837 // that if (p&BLOCK_MASK) >= (free&BLOCK_MASK), then we
838 // definitely have enough room. Also see bug #1147.
839 iptr = get_threaded_info(p);
840 info = INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure *)iptr));
844 p = thread_obj(info, p);
847 if (free + size > free_bd->start + BLOCK_SIZE_W) {
848 // unset the next bit in the bitmap to indicate that
849 // this object needs to be pushed into the next
850 // block. This saves us having to run down the
851 // threaded info pointer list twice during the next pass.
853 free_bd = free_bd->link;
854 free = free_bd->start;
856 ASSERT(is_marked(q+1,bd));
859 unthread(q,(StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
869 update_bkwd_compact( step *stp )
875 bdescr *bd, *free_bd;
877 nat size, free_blocks;
880 bd = free_bd = stp->old_blocks;
881 free = free_bd->start;
884 // cycle through all the blocks in the step
885 for (; bd != NULL; bd = bd->link) {
888 while (p < bd->free ) {
890 while ( p < bd->free && !is_marked(p,bd) ) {
899 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
900 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
902 while ( p < bd->free ) {
907 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
915 if (!is_marked(p+1,bd)) {
916 // don't forget to update the free ptr in the block desc.
917 free_bd->free = free;
918 free_bd = free_bd->link;
919 free = free_bd->start;
923 iptr = get_threaded_info(p);
924 unthread(p, (StgWord)free + GET_CLOSURE_TAG((StgClosure *)iptr));
925 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
926 info = get_itbl((StgClosure *)p);
927 size = closure_sizeW_((StgClosure *)p,info);
934 if (info->type == TSO) {
935 move_TSO((StgTSO *)p, (StgTSO *)free);
946 // free the remaining blocks and count what's left.
947 free_bd->free = free;
948 if (free_bd->link != NULL) {
949 freeChain(free_bd->link);
950 free_bd->link = NULL;
962 // 1. thread the roots
963 GetRoots((evac_fn)thread);
965 // the weak pointer lists...
966 if (weak_ptr_list != NULL) {
967 thread((void *)&weak_ptr_list);
969 if (old_weak_ptr_list != NULL) {
970 thread((void *)&old_weak_ptr_list); // tmp
974 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
977 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
978 for (p = bd->start; p < bd->free; p++) {
979 thread((StgClosure **)p);
984 // the global thread list
985 thread((void *)&all_threads);
987 // any threads resurrected during this GC
988 thread((void *)&resurrected_threads);
993 for (task = all_tasks; task != NULL; task = task->all_link) {
1000 // the static objects
1001 thread_static(scavenged_static_objects);
1003 // the stable pointer table
1004 threadStablePtrTable((evac_fn)thread);
1006 // the CAF list (used by GHCi)
1007 markCAFs((evac_fn)thread);
1009 // 2. update forward ptrs
1010 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
1011 for (s = 0; s < generations[g].n_steps; s++) {
1012 if (g==0 && s ==0) continue;
1013 stp = &generations[g].steps[s];
1014 debugTrace(DEBUG_gc, "update_fwd: %d.%d",
1015 stp->gen->no, stp->no);
1017 update_fwd(stp->blocks);
1018 update_fwd_large(stp->scavenged_large_objects);
1019 if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
1020 debugTrace(DEBUG_gc, "update_fwd: %d.%d (compact)",
1021 stp->gen->no, stp->no);
1022 update_fwd_compact(stp->old_blocks);
1027 // 3. update backward ptrs
1028 stp = &oldest_gen->steps[0];
1029 if (stp->old_blocks != NULL) {
1030 blocks = update_bkwd_compact(stp);
1031 debugTrace(DEBUG_gc,
1032 "update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)",
1033 stp->gen->no, stp->no,
1034 stp->n_old_blocks, blocks);
1035 stp->n_old_blocks = blocks;