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 We use a trick to identify the info pointer: when swapping pointers
50 for threading, we set the low bit of the original pointer, with the
51 result that all the pointers in the chain have their low bits set
52 except for the info pointer.
53 -------------------------------------------------------------------------- */
56 thread (StgClosure **p)
58 StgPtr q = *(StgPtr *)p;
61 // It doesn't look like a closure at the moment, because the info
62 // ptr is possibly threaded:
63 // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
65 if (HEAP_ALLOCED(q)) {
67 // a handy way to discover whether the ptr is into the
68 // compacted area of the old gen, is that the EVACUATED flag
69 // is zero (it's non-zero for all the other areas of live
71 if ((bd->flags & BF_EVACUATED) == 0) {
73 *(StgPtr)p = (StgWord)*q;
74 *q = (StgWord)p + 1; // set the low bit
79 // This version of thread() takes a (void *), used to circumvent
80 // warnings from gcc about pointer punning and strict aliasing.
81 STATIC_INLINE void thread_ (void *p) { thread((StgClosure **)p); }
84 unthread( StgPtr p, StgPtr free )
88 while ((q & 1) != 0) {
89 q -= 1; // unset the low bit again
91 *((StgPtr)q) = (StgWord)free;
97 STATIC_INLINE StgInfoTable *
98 get_threaded_info( StgPtr p )
100 StgPtr q = (P_)GET_INFO((StgClosure *)p);
102 while (((StgWord)q & 1) != 0) {
103 q = (P_)*((StgPtr)((StgWord)q-1));
106 ASSERT(LOOKS_LIKE_INFO_PTR(q));
107 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
110 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
111 // Remember, the two regions *might* overlap, but: to <= from.
113 move(StgPtr to, StgPtr from, nat size)
115 for(; size > 0; --size) {
121 thread_static( StgClosure* p )
123 const StgInfoTable *info;
125 // keep going until we've threaded all the objects on the linked
127 while (p != END_OF_STATIC_LIST) {
130 switch (info->type) {
133 thread(&((StgInd *)p)->indirectee);
134 p = *IND_STATIC_LINK(p);
138 p = *THUNK_STATIC_LINK(p);
141 p = *FUN_STATIC_LINK(p);
144 p = *STATIC_LINK(info,p);
148 barf("thread_static: strange closure %d", (int)(info->type));
155 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
161 bitmap = large_bitmap->bitmap[b];
162 for (i = 0; i < size; ) {
163 if ((bitmap & 1) == 0) {
164 thread((StgClosure **)p);
168 if (i % BITS_IN(W_) == 0) {
170 bitmap = large_bitmap->bitmap[b];
172 bitmap = bitmap >> 1;
178 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
185 switch (fun_info->f.fun_type) {
187 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
188 size = BITMAP_SIZE(fun_info->f.b.bitmap);
191 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
192 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
196 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
197 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
200 if ((bitmap & 1) == 0) {
201 thread((StgClosure **)p);
204 bitmap = bitmap >> 1;
213 thread_stack(StgPtr p, StgPtr stack_end)
215 const StgRetInfoTable* info;
219 // highly similar to scavenge_stack, but we do pointer threading here.
221 while (p < stack_end) {
223 // *p must be the info pointer of an activation
224 // record. All activation records have 'bitmap' style layout
227 info = get_ret_itbl((StgClosure *)p);
229 switch (info->i.type) {
231 // Dynamic bitmap: the mask is stored on the stack
235 dyn = ((StgRetDyn *)p)->liveness;
237 // traverse the bitmap first
238 bitmap = RET_DYN_LIVENESS(dyn);
239 p = (P_)&((StgRetDyn *)p)->payload[0];
240 size = RET_DYN_BITMAP_SIZE;
242 if ((bitmap & 1) == 0) {
243 thread((StgClosure **)p);
246 bitmap = bitmap >> 1;
250 // skip over the non-ptr words
251 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
253 // follow the ptr words
254 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
255 thread((StgClosure **)p);
261 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
262 case CATCH_RETRY_FRAME:
263 case CATCH_STM_FRAME:
264 case ATOMICALLY_FRAME:
270 bitmap = BITMAP_BITS(info->i.layout.bitmap);
271 size = BITMAP_SIZE(info->i.layout.bitmap);
273 // NOTE: the payload starts immediately after the info-ptr, we
274 // don't have an StgHeader in the same sense as a heap closure.
276 if ((bitmap & 1) == 0) {
277 thread((StgClosure **)p);
280 bitmap = bitmap >> 1;
291 thread((StgClosure **)p);
293 size = BCO_BITMAP_SIZE(bco);
294 thread_large_bitmap(p, BCO_BITMAP(bco), size);
299 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
303 size = GET_LARGE_BITMAP(&info->i)->size;
304 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
310 StgRetFun *ret_fun = (StgRetFun *)p;
311 StgFunInfoTable *fun_info;
313 fun_info = itbl_to_fun_itbl(
314 get_threaded_info((StgPtr)ret_fun->fun));
315 // *before* threading it!
316 thread(&ret_fun->fun);
317 p = thread_arg_block(fun_info, ret_fun->payload);
322 barf("thread_stack: weird activation record found on stack: %d",
323 (int)(info->i.type));
329 thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
333 StgFunInfoTable *fun_info;
335 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)fun));
336 ASSERT(fun_info->i.type != PAP);
340 switch (fun_info->f.fun_type) {
342 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
345 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
349 thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
353 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
356 if ((bitmap & 1) == 0) {
357 thread((StgClosure **)p);
360 bitmap = bitmap >> 1;
370 thread_PAP (StgPAP *pap)
373 p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
379 thread_AP (StgAP *ap)
382 p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
388 thread_AP_STACK (StgAP_STACK *ap)
391 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
392 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
396 thread_TSO (StgTSO *tso)
399 thread_(&tso->global_link);
401 if ( tso->why_blocked == BlockedOnMVar
402 || tso->why_blocked == BlockedOnBlackHole
403 || tso->why_blocked == BlockedOnException
405 thread_(&tso->block_info.closure);
407 thread_(&tso->blocked_exceptions);
411 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
412 return (StgPtr)tso + tso_sizeW(tso);
417 update_fwd_large( bdescr *bd )
420 const StgInfoTable* info;
422 for (; bd != NULL; bd = bd->link) {
425 info = get_itbl((StgClosure *)p);
427 switch (info->type) {
433 case MUT_ARR_PTRS_CLEAN:
434 case MUT_ARR_PTRS_DIRTY:
435 case MUT_ARR_PTRS_FROZEN:
436 case MUT_ARR_PTRS_FROZEN0:
441 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
442 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
443 thread((StgClosure **)p);
449 thread_TSO((StgTSO *)p);
453 thread_AP_STACK((StgAP_STACK *)p);
457 thread_PAP((StgPAP *)p);
463 StgTRecChunk *tc = (StgTRecChunk *)p;
464 TRecEntry *e = &(tc -> entries[0]);
465 thread_(&tc->prev_chunk);
466 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
468 thread(&e->expected_value);
469 thread(&e->new_value);
475 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
480 // ToDo: too big to inline
481 static /* STATIC_INLINE */ StgPtr
482 thread_obj (StgInfoTable *info, StgPtr p)
484 switch (info->type) {
486 return p + sizeofW(StgThunk) + 1;
490 return p + sizeofW(StgHeader) + 1;
494 thread(&((StgClosure *)p)->payload[0]);
495 return p + sizeofW(StgHeader) + 1;
498 thread(&((StgThunk *)p)->payload[0]);
499 return p + sizeofW(StgThunk) + 1;
502 return p + sizeofW(StgThunk) + 2;
506 return p + sizeofW(StgHeader) + 2;
509 thread(&((StgThunk *)p)->payload[0]);
510 return p + sizeofW(StgThunk) + 2;
514 thread(&((StgClosure *)p)->payload[0]);
515 return p + sizeofW(StgHeader) + 2;
518 thread(&((StgThunk *)p)->payload[0]);
519 thread(&((StgThunk *)p)->payload[1]);
520 return p + sizeofW(StgThunk) + 2;
524 thread(&((StgClosure *)p)->payload[0]);
525 thread(&((StgClosure *)p)->payload[1]);
526 return p + sizeofW(StgHeader) + 2;
529 StgBCO *bco = (StgBCO *)p;
530 thread_(&bco->instrs);
531 thread_(&bco->literals);
533 thread_(&bco->itbls);
534 return p + bco_sizeW(bco);
541 end = (P_)((StgThunk *)p)->payload +
542 info->layout.payload.ptrs;
543 for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
544 thread((StgClosure **)p);
546 return p + info->layout.payload.nptrs;
556 case SE_CAF_BLACKHOLE:
562 end = (P_)((StgClosure *)p)->payload +
563 info->layout.payload.ptrs;
564 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
565 thread((StgClosure **)p);
567 return p + info->layout.payload.nptrs;
572 StgWeak *w = (StgWeak *)p;
575 thread(&w->finalizer);
576 if (w->link != NULL) {
579 return p + sizeofW(StgWeak);
584 StgMVar *mvar = (StgMVar *)p;
585 thread_(&mvar->head);
586 thread_(&mvar->tail);
587 thread(&mvar->value);
588 return p + sizeofW(StgMVar);
592 case IND_OLDGEN_PERM:
593 thread(&((StgInd *)p)->indirectee);
594 return p + sizeofW(StgInd);
598 StgSelector *s = (StgSelector *)p;
599 thread(&s->selectee);
600 return p + THUNK_SELECTOR_sizeW();
604 return thread_AP_STACK((StgAP_STACK *)p);
607 return thread_PAP((StgPAP *)p);
610 return thread_AP((StgAP *)p);
613 return p + arr_words_sizeW((StgArrWords *)p);
615 case MUT_ARR_PTRS_CLEAN:
616 case MUT_ARR_PTRS_DIRTY:
617 case MUT_ARR_PTRS_FROZEN:
618 case MUT_ARR_PTRS_FROZEN0:
623 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
624 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
625 thread((StgClosure **)p);
631 return thread_TSO((StgTSO *)p);
633 case TVAR_WATCH_QUEUE:
635 StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p;
636 thread_(&wq->closure);
637 thread_(&wq->next_queue_entry);
638 thread_(&wq->prev_queue_entry);
639 return p + sizeofW(StgTVarWatchQueue);
644 StgTVar *tvar = (StgTVar *)p;
645 thread((void *)&tvar->current_value);
646 thread((void *)&tvar->first_watch_queue_entry);
647 return p + sizeofW(StgTVar);
652 StgTRecHeader *trec = (StgTRecHeader *)p;
653 thread_(&trec->enclosing_trec);
654 thread_(&trec->current_chunk);
655 thread_(&trec->invariants_to_check);
656 return p + sizeofW(StgTRecHeader);
662 StgTRecChunk *tc = (StgTRecChunk *)p;
663 TRecEntry *e = &(tc -> entries[0]);
664 thread_(&tc->prev_chunk);
665 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
667 thread(&e->expected_value);
668 thread(&e->new_value);
670 return p + sizeofW(StgTRecChunk);
673 case ATOMIC_INVARIANT:
675 StgAtomicInvariant *invariant = (StgAtomicInvariant *)p;
676 thread_(&invariant->code);
677 thread_(&invariant->last_execution);
678 return p + sizeofW(StgAtomicInvariant);
681 case INVARIANT_CHECK_QUEUE:
683 StgInvariantCheckQueue *queue = (StgInvariantCheckQueue *)p;
684 thread_(&queue->invariant);
685 thread_(&queue->my_execution);
686 thread_(&queue->next_queue_entry);
687 return p + sizeofW(StgInvariantCheckQueue);
691 barf("update_fwd: unknown/strange object %d", (int)(info->type));
697 update_fwd( bdescr *blocks )
705 // cycle through all the blocks in the step
706 for (; bd != NULL; bd = bd->link) {
709 // linearly scan the objects in this block
710 while (p < bd->free) {
711 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
712 info = get_itbl((StgClosure *)p);
713 p = thread_obj(info, p);
719 update_fwd_compact( bdescr *blocks )
725 bdescr *bd, *free_bd;
731 free = free_bd->start;
733 // cycle through all the blocks in the step
734 for (; bd != NULL; bd = bd->link) {
737 while (p < bd->free ) {
739 while ( p < bd->free && !is_marked(p,bd) ) {
748 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
749 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
751 while ( p < bd->free ) {
756 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
764 // Problem: we need to know the destination for this cell
765 // in order to unthread its info pointer. But we can't
766 // know the destination without the size, because we may
767 // spill into the next block. So we have to run down the
768 // threaded list and get the info ptr first.
769 info = get_threaded_info(p);
773 p = thread_obj(info, p);
776 if (free + size > free_bd->start + BLOCK_SIZE_W) {
777 // unset the next bit in the bitmap to indicate that
778 // this object needs to be pushed into the next
779 // block. This saves us having to run down the
780 // threaded info pointer list twice during the next pass.
782 free_bd = free_bd->link;
783 free = free_bd->start;
785 ASSERT(is_marked(q+1,bd));
798 update_bkwd_compact( step *stp )
804 bdescr *bd, *free_bd;
806 nat size, free_blocks;
808 bd = free_bd = stp->old_blocks;
809 free = free_bd->start;
812 // cycle through all the blocks in the step
813 for (; bd != NULL; bd = bd->link) {
816 while (p < bd->free ) {
818 while ( p < bd->free && !is_marked(p,bd) ) {
827 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
828 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
830 while ( p < bd->free ) {
835 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
843 if (!is_marked(p+1,bd)) {
844 // don't forget to update the free ptr in the block desc.
845 free_bd->free = free;
846 free_bd = free_bd->link;
847 free = free_bd->start;
852 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
853 info = get_itbl((StgClosure *)p);
854 size = closure_sizeW_((StgClosure *)p,info);
861 if (info->type == TSO) {
862 move_TSO((StgTSO *)p, (StgTSO *)free);
873 // free the remaining blocks and count what's left.
874 free_bd->free = free;
875 if (free_bd->link != NULL) {
876 freeChain(free_bd->link);
877 free_bd->link = NULL;
889 // 1. thread the roots
890 GetRoots((evac_fn)thread);
892 // the weak pointer lists...
893 if (weak_ptr_list != NULL) {
894 thread((void *)&weak_ptr_list);
896 if (old_weak_ptr_list != NULL) {
897 thread((void *)&old_weak_ptr_list); // tmp
901 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
904 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
905 for (p = bd->start; p < bd->free; p++) {
906 thread((StgClosure **)p);
911 // the global thread list
912 thread((void *)&all_threads);
914 // any threads resurrected during this GC
915 thread((void *)&resurrected_threads);
920 for (task = all_tasks; task != NULL; task = task->all_link) {
927 // the static objects
928 thread_static(scavenged_static_objects);
930 // the stable pointer table
931 threadStablePtrTable((evac_fn)thread);
933 // the CAF list (used by GHCi)
934 markCAFs((evac_fn)thread);
936 // 2. update forward ptrs
937 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
938 for (s = 0; s < generations[g].n_steps; s++) {
939 if (g==0 && s ==0) continue;
940 stp = &generations[g].steps[s];
941 debugTrace(DEBUG_gc, "update_fwd: %d.%d",
942 stp->gen->no, stp->no);
944 update_fwd(stp->blocks);
945 update_fwd_large(stp->scavenged_large_objects);
946 if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
947 debugTrace(DEBUG_gc, "update_fwd: %d.%d (compact)",
948 stp->gen->no, stp->no);
949 update_fwd_compact(stp->old_blocks);
954 // 3. update backward ptrs
955 stp = &oldest_gen->steps[0];
956 if (stp->old_blocks != NULL) {
957 blocks = update_bkwd_compact(stp);
959 "update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)",
960 stp->gen->no, stp->no,
961 stp->n_old_blocks, blocks);
962 stp->n_old_blocks = blocks;