1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team 2001
5 * Compacting garbage collector
7 * ---------------------------------------------------------------------------*/
9 #include "PosixSource.h"
13 #include "OSThreads.h"
16 #include "BlockAlloc.h"
24 // Turn off inlining when debugging - it obfuscates things
27 # define STATIC_INLINE static
30 /* -----------------------------------------------------------------------------
31 Threading / unthreading pointers.
33 The basic idea here is to chain together all the fields pointing at
34 a particular object, with the root of the chain in the object's
35 info table field. The original contents of the info pointer goes
36 at the end of the chain.
38 Adding a new field to the chain is a matter of swapping the
39 contents of the field with the contents of the object's info table
42 To unthread the chain, we walk down it updating all the fields on
43 the chain with the new location of the object. We stop when we
44 reach the info pointer at the end.
46 We use a trick to identify the info pointer: when swapping pointers
47 for threading, we set the low bit of the original pointer, with the
48 result that all the pointers in the chain have their low bits set
49 except for the info pointer.
50 -------------------------------------------------------------------------- */
53 thread (StgClosure **p)
55 StgPtr q = *(StgPtr *)p;
58 // It doesn't look like a closure at the moment, because the info
59 // ptr is possibly threaded:
60 // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
62 if (HEAP_ALLOCED(q)) {
64 // a handy way to discover whether the ptr is into the
65 // compacted area of the old gen, is that the EVACUATED flag
66 // is zero (it's non-zero for all the other areas of live
68 if ((bd->flags & BF_EVACUATED) == 0) {
70 *(StgPtr)p = (StgWord)*q;
71 *q = (StgWord)p + 1; // set the low bit
76 // This version of thread() takes a (void *), used to circumvent
77 // warnings from gcc about pointer punning and strict aliasing.
78 STATIC_INLINE void thread_ (void *p) { thread((StgClosure **)p); }
81 unthread( StgPtr p, StgPtr free )
85 while ((q & 1) != 0) {
86 q -= 1; // unset the low bit again
88 *((StgPtr)q) = (StgWord)free;
94 STATIC_INLINE StgInfoTable *
95 get_threaded_info( StgPtr p )
97 StgPtr q = (P_)GET_INFO((StgClosure *)p);
99 while (((StgWord)q & 1) != 0) {
100 q = (P_)*((StgPtr)((StgWord)q-1));
103 ASSERT(LOOKS_LIKE_INFO_PTR(q));
104 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
107 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
108 // Remember, the two regions *might* overlap, but: to <= from.
110 move(StgPtr to, StgPtr from, nat size)
112 for(; size > 0; --size) {
118 thread_static( StgClosure* p )
120 const StgInfoTable *info;
122 // keep going until we've threaded all the objects on the linked
124 while (p != END_OF_STATIC_LIST) {
127 switch (info->type) {
130 thread(&((StgInd *)p)->indirectee);
131 p = *IND_STATIC_LINK(p);
135 p = *THUNK_STATIC_LINK(p);
138 p = *FUN_STATIC_LINK(p);
141 p = *STATIC_LINK(info,p);
145 barf("thread_static: strange closure %d", (int)(info->type));
152 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
158 bitmap = large_bitmap->bitmap[b];
159 for (i = 0; i < size; ) {
160 if ((bitmap & 1) == 0) {
161 thread((StgClosure **)p);
165 if (i % BITS_IN(W_) == 0) {
167 bitmap = large_bitmap->bitmap[b];
169 bitmap = bitmap >> 1;
175 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
182 switch (fun_info->f.fun_type) {
184 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
185 size = BITMAP_SIZE(fun_info->f.b.bitmap);
188 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
189 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
193 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
194 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
197 if ((bitmap & 1) == 0) {
198 thread((StgClosure **)p);
201 bitmap = bitmap >> 1;
210 thread_stack(StgPtr p, StgPtr stack_end)
212 const StgRetInfoTable* info;
216 // highly similar to scavenge_stack, but we do pointer threading here.
218 while (p < stack_end) {
220 // *p must be the info pointer of an activation
221 // record. All activation records have 'bitmap' style layout
224 info = get_ret_itbl((StgClosure *)p);
226 switch (info->i.type) {
228 // Dynamic bitmap: the mask is stored on the stack
232 dyn = ((StgRetDyn *)p)->liveness;
234 // traverse the bitmap first
235 bitmap = RET_DYN_LIVENESS(dyn);
236 p = (P_)&((StgRetDyn *)p)->payload[0];
237 size = RET_DYN_BITMAP_SIZE;
239 if ((bitmap & 1) == 0) {
240 thread((StgClosure **)p);
243 bitmap = bitmap >> 1;
247 // skip over the non-ptr words
248 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
250 // follow the ptr words
251 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
252 thread((StgClosure **)p);
258 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
259 case CATCH_RETRY_FRAME:
260 case CATCH_STM_FRAME:
261 case ATOMICALLY_FRAME:
267 bitmap = BITMAP_BITS(info->i.layout.bitmap);
268 size = BITMAP_SIZE(info->i.layout.bitmap);
270 // NOTE: the payload starts immediately after the info-ptr, we
271 // don't have an StgHeader in the same sense as a heap closure.
273 if ((bitmap & 1) == 0) {
274 thread((StgClosure **)p);
277 bitmap = bitmap >> 1;
288 thread((StgClosure **)p);
290 size = BCO_BITMAP_SIZE(bco);
291 thread_large_bitmap(p, BCO_BITMAP(bco), size);
296 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
300 size = GET_LARGE_BITMAP(&info->i)->size;
301 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
307 StgRetFun *ret_fun = (StgRetFun *)p;
308 StgFunInfoTable *fun_info;
310 fun_info = itbl_to_fun_itbl(
311 get_threaded_info((StgPtr)ret_fun->fun));
312 // *before* threading it!
313 thread(&ret_fun->fun);
314 p = thread_arg_block(fun_info, ret_fun->payload);
319 barf("thread_stack: weird activation record found on stack: %d",
320 (int)(info->i.type));
326 thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
330 StgFunInfoTable *fun_info;
332 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)fun));
333 ASSERT(fun_info->i.type != PAP);
337 switch (fun_info->f.fun_type) {
339 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
342 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
346 thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
350 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
353 if ((bitmap & 1) == 0) {
354 thread((StgClosure **)p);
357 bitmap = bitmap >> 1;
367 thread_PAP (StgPAP *pap)
370 p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
376 thread_AP (StgAP *ap)
379 p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
385 thread_AP_STACK (StgAP_STACK *ap)
388 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
389 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
393 thread_TSO (StgTSO *tso)
396 thread_(&tso->global_link);
398 if ( tso->why_blocked == BlockedOnMVar
399 || tso->why_blocked == BlockedOnBlackHole
400 || tso->why_blocked == BlockedOnException
402 || tso->why_blocked == BlockedOnGA
403 || tso->why_blocked == BlockedOnGA_NoSend
406 thread_(&tso->block_info.closure);
408 thread_(&tso->blocked_exceptions);
412 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
413 return (StgPtr)tso + tso_sizeW(tso);
418 update_fwd_large( bdescr *bd )
421 const StgInfoTable* info;
423 for (; bd != NULL; bd = bd->link) {
426 info = get_itbl((StgClosure *)p);
428 switch (info->type) {
434 case MUT_ARR_PTRS_CLEAN:
435 case MUT_ARR_PTRS_DIRTY:
436 case MUT_ARR_PTRS_FROZEN:
437 case MUT_ARR_PTRS_FROZEN0:
442 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
443 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
444 thread((StgClosure **)p);
450 thread_TSO((StgTSO *)p);
454 thread_AP_STACK((StgAP_STACK *)p);
458 thread_PAP((StgPAP *)p);
464 StgTRecChunk *tc = (StgTRecChunk *)p;
465 TRecEntry *e = &(tc -> entries[0]);
466 thread_(&tc->prev_chunk);
467 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
469 thread(&e->expected_value);
470 thread(&e->new_value);
476 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
481 // ToDo: too big to inline
482 static /* STATIC_INLINE */ StgPtr
483 thread_obj (StgInfoTable *info, StgPtr p)
485 switch (info->type) {
487 return p + sizeofW(StgThunk) + 1;
491 return p + sizeofW(StgHeader) + 1;
495 thread(&((StgClosure *)p)->payload[0]);
496 return p + sizeofW(StgHeader) + 1;
499 thread(&((StgThunk *)p)->payload[0]);
500 return p + sizeofW(StgThunk) + 1;
503 return p + sizeofW(StgThunk) + 2;
507 return p + sizeofW(StgHeader) + 2;
510 thread(&((StgThunk *)p)->payload[0]);
511 return p + sizeofW(StgThunk) + 2;
515 thread(&((StgClosure *)p)->payload[0]);
516 return p + sizeofW(StgHeader) + 2;
519 thread(&((StgThunk *)p)->payload[0]);
520 thread(&((StgThunk *)p)->payload[1]);
521 return p + sizeofW(StgThunk) + 2;
525 thread(&((StgClosure *)p)->payload[0]);
526 thread(&((StgClosure *)p)->payload[1]);
527 return p + sizeofW(StgHeader) + 2;
530 StgBCO *bco = (StgBCO *)p;
531 thread_(&bco->instrs);
532 thread_(&bco->literals);
534 thread_(&bco->itbls);
535 return p + bco_sizeW(bco);
542 end = (P_)((StgThunk *)p)->payload +
543 info->layout.payload.ptrs;
544 for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
545 thread((StgClosure **)p);
547 return p + info->layout.payload.nptrs;
557 case SE_CAF_BLACKHOLE:
563 end = (P_)((StgClosure *)p)->payload +
564 info->layout.payload.ptrs;
565 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
566 thread((StgClosure **)p);
568 return p + info->layout.payload.nptrs;
573 StgWeak *w = (StgWeak *)p;
576 thread(&w->finalizer);
577 if (w->link != NULL) {
580 return p + sizeofW(StgWeak);
585 StgMVar *mvar = (StgMVar *)p;
586 thread_(&mvar->head);
587 thread_(&mvar->tail);
588 thread(&mvar->value);
589 return p + sizeofW(StgMVar);
593 case IND_OLDGEN_PERM:
594 thread(&((StgInd *)p)->indirectee);
595 return p + sizeofW(StgInd);
599 StgSelector *s = (StgSelector *)p;
600 thread(&s->selectee);
601 return p + THUNK_SELECTOR_sizeW();
605 return thread_AP_STACK((StgAP_STACK *)p);
608 return thread_PAP((StgPAP *)p);
611 return thread_AP((StgAP *)p);
614 return p + arr_words_sizeW((StgArrWords *)p);
616 case MUT_ARR_PTRS_CLEAN:
617 case MUT_ARR_PTRS_DIRTY:
618 case MUT_ARR_PTRS_FROZEN:
619 case MUT_ARR_PTRS_FROZEN0:
624 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
625 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
626 thread((StgClosure **)p);
632 return thread_TSO((StgTSO *)p);
634 case TVAR_WATCH_QUEUE:
636 StgTVarWatchQueue *wq = (StgTVarWatchQueue *)p;
637 thread_(&wq->closure);
638 thread_(&wq->next_queue_entry);
639 thread_(&wq->prev_queue_entry);
640 return p + sizeofW(StgTVarWatchQueue);
645 StgTVar *tvar = (StgTVar *)p;
646 thread((void *)&tvar->current_value);
647 thread((void *)&tvar->first_watch_queue_entry);
648 return p + sizeofW(StgTVar);
653 StgTRecHeader *trec = (StgTRecHeader *)p;
654 thread_(&trec->enclosing_trec);
655 thread_(&trec->current_chunk);
656 thread_(&trec->invariants_to_check);
657 return p + sizeofW(StgTRecHeader);
663 StgTRecChunk *tc = (StgTRecChunk *)p;
664 TRecEntry *e = &(tc -> entries[0]);
665 thread_(&tc->prev_chunk);
666 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
668 thread(&e->expected_value);
669 thread(&e->new_value);
671 return p + sizeofW(StgTRecChunk);
674 case ATOMIC_INVARIANT:
676 StgAtomicInvariant *invariant = (StgAtomicInvariant *)p;
677 thread_(&invariant->code);
678 thread_(&invariant->last_execution);
679 return p + sizeofW(StgAtomicInvariant);
682 case INVARIANT_CHECK_QUEUE:
684 StgInvariantCheckQueue *queue = (StgInvariantCheckQueue *)p;
685 thread_(&queue->invariant);
686 thread_(&queue->my_execution);
687 thread_(&queue->next_queue_entry);
688 return p + sizeofW(StgInvariantCheckQueue);
692 barf("update_fwd: unknown/strange object %d", (int)(info->type));
698 update_fwd( bdescr *blocks )
707 barf("update_fwd: ToDo");
710 // cycle through all the blocks in the step
711 for (; bd != NULL; bd = bd->link) {
714 // linearly scan the objects in this block
715 while (p < bd->free) {
716 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
717 info = get_itbl((StgClosure *)p);
718 p = thread_obj(info, p);
724 update_fwd_compact( bdescr *blocks )
730 bdescr *bd, *free_bd;
736 free = free_bd->start;
739 barf("update_fwd: ToDo");
742 // cycle through all the blocks in the step
743 for (; bd != NULL; bd = bd->link) {
746 while (p < bd->free ) {
748 while ( p < bd->free && !is_marked(p,bd) ) {
757 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
758 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
760 while ( p < bd->free ) {
765 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
773 // Problem: we need to know the destination for this cell
774 // in order to unthread its info pointer. But we can't
775 // know the destination without the size, because we may
776 // spill into the next block. So we have to run down the
777 // threaded list and get the info ptr first.
778 info = get_threaded_info(p);
782 p = thread_obj(info, p);
785 if (free + size > free_bd->start + BLOCK_SIZE_W) {
786 // unset the next bit in the bitmap to indicate that
787 // this object needs to be pushed into the next
788 // block. This saves us having to run down the
789 // threaded info pointer list twice during the next pass.
791 free_bd = free_bd->link;
792 free = free_bd->start;
794 ASSERT(is_marked(q+1,bd));
807 update_bkwd_compact( step *stp )
813 bdescr *bd, *free_bd;
815 nat size, free_blocks;
817 bd = free_bd = stp->old_blocks;
818 free = free_bd->start;
822 barf("update_bkwd: ToDo");
825 // cycle through all the blocks in the step
826 for (; bd != NULL; bd = bd->link) {
829 while (p < bd->free ) {
831 while ( p < bd->free && !is_marked(p,bd) ) {
840 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
841 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
843 while ( p < bd->free ) {
848 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
856 if (!is_marked(p+1,bd)) {
857 // don't forget to update the free ptr in the block desc.
858 free_bd->free = free;
859 free_bd = free_bd->link;
860 free = free_bd->start;
865 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
866 info = get_itbl((StgClosure *)p);
867 size = closure_sizeW_((StgClosure *)p,info);
874 if (info->type == TSO) {
875 move_TSO((StgTSO *)p, (StgTSO *)free);
886 // free the remaining blocks and count what's left.
887 free_bd->free = free;
888 if (free_bd->link != NULL) {
889 freeChain(free_bd->link);
890 free_bd->link = NULL;
902 // 1. thread the roots
903 GetRoots((evac_fn)thread);
905 // the weak pointer lists...
906 if (weak_ptr_list != NULL) {
907 thread((void *)&weak_ptr_list);
909 if (old_weak_ptr_list != NULL) {
910 thread((void *)&old_weak_ptr_list); // tmp
914 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
917 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
918 for (p = bd->start; p < bd->free; p++) {
919 thread((StgClosure **)p);
924 // the global thread list
925 thread((void *)&all_threads);
927 // any threads resurrected during this GC
928 thread((void *)&resurrected_threads);
933 for (task = all_tasks; task != NULL; task = task->all_link) {
940 // the static objects
941 thread_static(scavenged_static_objects);
943 // the stable pointer table
944 threadStablePtrTable((evac_fn)thread);
946 // the CAF list (used by GHCi)
947 markCAFs((evac_fn)thread);
949 // 2. update forward ptrs
950 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
951 for (s = 0; s < generations[g].n_steps; s++) {
952 if (g==0 && s ==0) continue;
953 stp = &generations[g].steps[s];
954 debugTrace(DEBUG_gc, "update_fwd: %d.%d",
955 stp->gen->no, stp->no);
957 update_fwd(stp->blocks);
958 update_fwd_large(stp->scavenged_large_objects);
959 if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
960 debugTrace(DEBUG_gc, "update_fwd: %d.%d (compact)",
961 stp->gen->no, stp->no);
962 update_fwd_compact(stp->old_blocks);
967 // 3. update backward ptrs
968 stp = &oldest_gen->steps[0];
969 if (stp->old_blocks != NULL) {
970 blocks = update_bkwd_compact(stp);
972 "update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)",
973 stp->gen->no, stp->no,
974 stp->n_old_blocks, blocks);
975 stp->n_old_blocks = blocks;