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:
269 bitmap = BITMAP_BITS(info->i.layout.bitmap);
270 size = BITMAP_SIZE(info->i.layout.bitmap);
272 // NOTE: the payload starts immediately after the info-ptr, we
273 // don't have an StgHeader in the same sense as a heap closure.
275 if ((bitmap & 1) == 0) {
276 thread((StgClosure **)p);
279 bitmap = bitmap >> 1;
290 thread((StgClosure **)p);
292 size = BCO_BITMAP_SIZE(bco);
293 thread_large_bitmap(p, BCO_BITMAP(bco), size);
298 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
301 size = GET_LARGE_BITMAP(&info->i)->size;
302 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
308 StgRetFun *ret_fun = (StgRetFun *)p;
309 StgFunInfoTable *fun_info;
311 fun_info = itbl_to_fun_itbl(
312 get_threaded_info((StgPtr)ret_fun->fun));
313 // *before* threading it!
314 thread(&ret_fun->fun);
315 p = thread_arg_block(fun_info, ret_fun->payload);
320 barf("thread_stack: weird activation record found on stack: %d",
321 (int)(info->i.type));
327 thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
331 StgFunInfoTable *fun_info;
333 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)fun));
334 ASSERT(fun_info->i.type != PAP);
338 switch (fun_info->f.fun_type) {
340 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
343 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
347 thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
351 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
354 if ((bitmap & 1) == 0) {
355 thread((StgClosure **)p);
358 bitmap = bitmap >> 1;
368 thread_PAP (StgPAP *pap)
371 p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
377 thread_AP (StgAP *ap)
380 p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
386 thread_AP_STACK (StgAP_STACK *ap)
389 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
390 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
394 thread_TSO (StgTSO *tso)
397 thread_(&tso->global_link);
399 if ( tso->why_blocked == BlockedOnMVar
400 || tso->why_blocked == BlockedOnBlackHole
401 || tso->why_blocked == BlockedOnException
403 thread_(&tso->block_info.closure);
405 thread_(&tso->blocked_exceptions);
409 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
410 return (StgPtr)tso + tso_sizeW(tso);
415 update_fwd_large( bdescr *bd )
418 const StgInfoTable* info;
420 for (; bd != NULL; bd = bd->link) {
423 info = get_itbl((StgClosure *)p);
425 switch (info->type) {
431 case MUT_ARR_PTRS_CLEAN:
432 case MUT_ARR_PTRS_DIRTY:
433 case MUT_ARR_PTRS_FROZEN:
434 case MUT_ARR_PTRS_FROZEN0:
439 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
440 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
441 thread((StgClosure **)p);
447 thread_TSO((StgTSO *)p);
451 thread_AP_STACK((StgAP_STACK *)p);
455 thread_PAP((StgPAP *)p);
461 StgTRecChunk *tc = (StgTRecChunk *)p;
462 TRecEntry *e = &(tc -> entries[0]);
463 thread_(&tc->prev_chunk);
464 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
466 thread(&e->expected_value);
467 thread(&e->new_value);
473 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
478 // ToDo: too big to inline
479 static /* STATIC_INLINE */ StgPtr
480 thread_obj (StgInfoTable *info, StgPtr p)
482 switch (info->type) {
484 return p + sizeofW(StgThunk) + 1;
488 return p + sizeofW(StgHeader) + 1;
492 thread(&((StgClosure *)p)->payload[0]);
493 return p + sizeofW(StgHeader) + 1;
496 thread(&((StgThunk *)p)->payload[0]);
497 return p + sizeofW(StgThunk) + 1;
500 return p + sizeofW(StgThunk) + 2;
504 return p + sizeofW(StgHeader) + 2;
507 thread(&((StgThunk *)p)->payload[0]);
508 return p + sizeofW(StgThunk) + 2;
512 thread(&((StgClosure *)p)->payload[0]);
513 return p + sizeofW(StgHeader) + 2;
516 thread(&((StgThunk *)p)->payload[0]);
517 thread(&((StgThunk *)p)->payload[1]);
518 return p + sizeofW(StgThunk) + 2;
522 thread(&((StgClosure *)p)->payload[0]);
523 thread(&((StgClosure *)p)->payload[1]);
524 return p + sizeofW(StgHeader) + 2;
527 StgBCO *bco = (StgBCO *)p;
528 thread_(&bco->instrs);
529 thread_(&bco->literals);
531 return p + bco_sizeW(bco);
538 end = (P_)((StgThunk *)p)->payload +
539 info->layout.payload.ptrs;
540 for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
541 thread((StgClosure **)p);
543 return p + info->layout.payload.nptrs;
553 case SE_CAF_BLACKHOLE:
559 end = (P_)((StgClosure *)p)->payload +
560 info->layout.payload.ptrs;
561 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
562 thread((StgClosure **)p);
564 return p + info->layout.payload.nptrs;
569 StgWeak *w = (StgWeak *)p;
572 thread(&w->finalizer);
573 if (w->link != NULL) {
576 return p + sizeofW(StgWeak);
581 StgMVar *mvar = (StgMVar *)p;
582 thread_(&mvar->head);
583 thread_(&mvar->tail);
584 thread(&mvar->value);
585 return p + sizeofW(StgMVar);
589 case IND_OLDGEN_PERM:
590 thread(&((StgInd *)p)->indirectee);
591 return p + sizeofW(StgInd);
595 StgSelector *s = (StgSelector *)p;
596 thread(&s->selectee);
597 return p + THUNK_SELECTOR_sizeW();
601 return thread_AP_STACK((StgAP_STACK *)p);
604 return thread_PAP((StgPAP *)p);
607 return thread_AP((StgAP *)p);
610 return p + arr_words_sizeW((StgArrWords *)p);
612 case MUT_ARR_PTRS_CLEAN:
613 case MUT_ARR_PTRS_DIRTY:
614 case MUT_ARR_PTRS_FROZEN:
615 case MUT_ARR_PTRS_FROZEN0:
620 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
621 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
622 thread((StgClosure **)p);
628 return thread_TSO((StgTSO *)p);
630 case TVAR_WATCH_QUEUE:
632 StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p;
633 thread_(&wq->closure);
634 thread_(&wq->next_queue_entry);
635 thread_(&wq->prev_queue_entry);
636 return p + sizeofW(StgTVarWatchQueue);
641 StgTVar *tvar = (StgTVar *)p;
642 thread((void *)&tvar->current_value);
643 thread((void *)&tvar->first_watch_queue_entry);
644 return p + sizeofW(StgTVar);
649 StgTRecHeader *trec = (StgTRecHeader *)p;
650 thread_(&trec->enclosing_trec);
651 thread_(&trec->current_chunk);
652 thread_(&trec->invariants_to_check);
653 return p + sizeofW(StgTRecHeader);
659 StgTRecChunk *tc = (StgTRecChunk *)p;
660 TRecEntry *e = &(tc -> entries[0]);
661 thread_(&tc->prev_chunk);
662 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
664 thread(&e->expected_value);
665 thread(&e->new_value);
667 return p + sizeofW(StgTRecChunk);
670 case ATOMIC_INVARIANT:
672 StgAtomicInvariant *invariant = (StgAtomicInvariant *)p;
673 thread_(&invariant->code);
674 thread_(&invariant->last_execution);
675 return p + sizeofW(StgAtomicInvariant);
678 case INVARIANT_CHECK_QUEUE:
680 StgInvariantCheckQueue *queue = (StgInvariantCheckQueue *)p;
681 thread_(&queue->invariant);
682 thread_(&queue->my_execution);
683 thread_(&queue->next_queue_entry);
684 return p + sizeofW(StgInvariantCheckQueue);
688 barf("update_fwd: unknown/strange object %d", (int)(info->type));
694 update_fwd( bdescr *blocks )
702 // cycle through all the blocks in the step
703 for (; bd != NULL; bd = bd->link) {
706 // linearly scan the objects in this block
707 while (p < bd->free) {
708 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
709 info = get_itbl((StgClosure *)p);
710 p = thread_obj(info, p);
716 update_fwd_compact( bdescr *blocks )
722 bdescr *bd, *free_bd;
728 free = free_bd->start;
730 // cycle through all the blocks in the step
731 for (; bd != NULL; bd = bd->link) {
734 while (p < bd->free ) {
736 while ( p < bd->free && !is_marked(p,bd) ) {
745 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
746 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
748 while ( p < bd->free ) {
753 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
761 // Problem: we need to know the destination for this cell
762 // in order to unthread its info pointer. But we can't
763 // know the destination without the size, because we may
764 // spill into the next block. So we have to run down the
765 // threaded list and get the info ptr first.
767 // ToDo: one possible avenue of attack is to use the fact
768 // that if (p&BLOCK_MASK) >= (free&BLOCK_MASK), then we
769 // definitely have enough room. Also see bug #1147.
770 info = get_threaded_info(p);
774 p = thread_obj(info, p);
777 if (free + size > free_bd->start + BLOCK_SIZE_W) {
778 // unset the next bit in the bitmap to indicate that
779 // this object needs to be pushed into the next
780 // block. This saves us having to run down the
781 // threaded info pointer list twice during the next pass.
783 free_bd = free_bd->link;
784 free = free_bd->start;
786 ASSERT(is_marked(q+1,bd));
799 update_bkwd_compact( step *stp )
805 bdescr *bd, *free_bd;
807 nat size, free_blocks;
809 bd = free_bd = stp->old_blocks;
810 free = free_bd->start;
813 // cycle through all the blocks in the step
814 for (; bd != NULL; bd = bd->link) {
817 while (p < bd->free ) {
819 while ( p < bd->free && !is_marked(p,bd) ) {
828 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
829 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
831 while ( p < bd->free ) {
836 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
844 if (!is_marked(p+1,bd)) {
845 // don't forget to update the free ptr in the block desc.
846 free_bd->free = free;
847 free_bd = free_bd->link;
848 free = free_bd->start;
853 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
854 info = get_itbl((StgClosure *)p);
855 size = closure_sizeW_((StgClosure *)p,info);
862 if (info->type == TSO) {
863 move_TSO((StgTSO *)p, (StgTSO *)free);
874 // free the remaining blocks and count what's left.
875 free_bd->free = free;
876 if (free_bd->link != NULL) {
877 freeChain(free_bd->link);
878 free_bd->link = NULL;
890 // 1. thread the roots
891 GetRoots((evac_fn)thread);
893 // the weak pointer lists...
894 if (weak_ptr_list != NULL) {
895 thread((void *)&weak_ptr_list);
897 if (old_weak_ptr_list != NULL) {
898 thread((void *)&old_weak_ptr_list); // tmp
902 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
905 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
906 for (p = bd->start; p < bd->free; p++) {
907 thread((StgClosure **)p);
912 // the global thread list
913 thread((void *)&all_threads);
915 // any threads resurrected during this GC
916 thread((void *)&resurrected_threads);
921 for (task = all_tasks; task != NULL; task = task->all_link) {
928 // the static objects
929 thread_static(scavenged_static_objects);
931 // the stable pointer table
932 threadStablePtrTable((evac_fn)thread);
934 // the CAF list (used by GHCi)
935 markCAFs((evac_fn)thread);
937 // 2. update forward ptrs
938 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
939 for (s = 0; s < generations[g].n_steps; s++) {
940 if (g==0 && s ==0) continue;
941 stp = &generations[g].steps[s];
942 debugTrace(DEBUG_gc, "update_fwd: %d.%d",
943 stp->gen->no, stp->no);
945 update_fwd(stp->blocks);
946 update_fwd_large(stp->scavenged_large_objects);
947 if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
948 debugTrace(DEBUG_gc, "update_fwd: %d.%d (compact)",
949 stp->gen->no, stp->no);
950 update_fwd_compact(stp->old_blocks);
955 // 3. update backward ptrs
956 stp = &oldest_gen->steps[0];
957 if (stp->old_blocks != NULL) {
958 blocks = update_bkwd_compact(stp);
960 "update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)",
961 stp->gen->no, stp->no,
962 stp->n_old_blocks, blocks);
963 stp->n_old_blocks = blocks;