1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team 2001
5 * Compacting garbage collector
7 * ---------------------------------------------------------------------------*/
9 #include "PosixSource.h"
13 #include "OSThreads.h"
15 #include "BlockAlloc.h"
17 #include "GCCompact.h"
21 // Turn off inlining when debugging - it obfuscates things
24 # define STATIC_INLINE static
27 /* -----------------------------------------------------------------------------
28 Threading / unthreading pointers.
30 The basic idea here is to chain together all the fields pointing at
31 a particular object, with the root of the chain in the object's
32 info table field. The original contents of the info pointer goes
33 at the end of the chain.
35 Adding a new field to the chain is a matter of swapping the
36 contents of the field with the contents of the object's info table
39 To unthread the chain, we walk down it updating all the fields on
40 the chain with the new location of the object. We stop when we
41 reach the info pointer at the end.
43 We use a trick to identify the info pointer: when swapping pointers
44 for threading, we set the low bit of the original pointer, with the
45 result that all the pointers in the chain have their low bits set
46 except for the info pointer.
47 -------------------------------------------------------------------------- */
50 thread (StgClosure **p)
52 StgPtr q = *(StgPtr *)p;
55 // It doesn't look like a closure at the moment, because the info
56 // ptr is possibly threaded:
57 // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
59 if (HEAP_ALLOCED(q)) {
61 // a handy way to discover whether the ptr is into the
62 // compacted area of the old gen, is that the EVACUATED flag
63 // is zero (it's non-zero for all the other areas of live
65 if ((bd->flags & BF_EVACUATED) == 0) {
67 *(StgPtr)p = (StgWord)*q;
68 *q = (StgWord)p + 1; // set the low bit
73 // This version of thread() takes a (void *), used to circumvent
74 // warnings from gcc about pointer punning and strict aliasing.
75 STATIC_INLINE void thread_ (void *p) { thread((StgClosure **)p); }
78 unthread( StgPtr p, StgPtr free )
82 while ((q & 1) != 0) {
83 q -= 1; // unset the low bit again
85 *((StgPtr)q) = (StgWord)free;
91 STATIC_INLINE StgInfoTable *
92 get_threaded_info( StgPtr p )
94 StgPtr q = (P_)GET_INFO((StgClosure *)p);
96 while (((StgWord)q & 1) != 0) {
97 q = (P_)*((StgPtr)((StgWord)q-1));
100 ASSERT(LOOKS_LIKE_INFO_PTR(q));
101 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
104 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
105 // Remember, the two regions *might* overlap, but: to <= from.
107 move(StgPtr to, StgPtr from, nat size)
109 for(; size > 0; --size) {
115 thread_static( StgClosure* p )
117 const StgInfoTable *info;
119 // keep going until we've threaded all the objects on the linked
121 while (p != END_OF_STATIC_LIST) {
124 switch (info->type) {
127 thread(&((StgInd *)p)->indirectee);
128 p = *IND_STATIC_LINK(p);
132 p = *THUNK_STATIC_LINK(p);
135 p = *FUN_STATIC_LINK(p);
138 p = *STATIC_LINK(info,p);
142 barf("thread_static: strange closure %d", (int)(info->type));
149 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
155 bitmap = large_bitmap->bitmap[b];
156 for (i = 0; i < size; ) {
157 if ((bitmap & 1) == 0) {
158 thread((StgClosure **)p);
162 if (i % BITS_IN(W_) == 0) {
164 bitmap = large_bitmap->bitmap[b];
166 bitmap = bitmap >> 1;
172 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
179 switch (fun_info->f.fun_type) {
181 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
182 size = BITMAP_SIZE(fun_info->f.b.bitmap);
185 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
186 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
190 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
191 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
194 if ((bitmap & 1) == 0) {
195 thread((StgClosure **)p);
198 bitmap = bitmap >> 1;
207 thread_stack(StgPtr p, StgPtr stack_end)
209 const StgRetInfoTable* info;
213 // highly similar to scavenge_stack, but we do pointer threading here.
215 while (p < stack_end) {
217 // *p must be the info pointer of an activation
218 // record. All activation records have 'bitmap' style layout
221 info = get_ret_itbl((StgClosure *)p);
223 switch (info->i.type) {
225 // Dynamic bitmap: the mask is stored on the stack
229 dyn = ((StgRetDyn *)p)->liveness;
231 // traverse the bitmap first
232 bitmap = RET_DYN_LIVENESS(dyn);
233 p = (P_)&((StgRetDyn *)p)->payload[0];
234 size = RET_DYN_BITMAP_SIZE;
236 if ((bitmap & 1) == 0) {
237 thread((StgClosure **)p);
240 bitmap = bitmap >> 1;
244 // skip over the non-ptr words
245 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
247 // follow the ptr words
248 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
249 thread((StgClosure **)p);
255 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
256 case CATCH_RETRY_FRAME:
257 case CATCH_STM_FRAME:
258 case ATOMICALLY_FRAME:
264 bitmap = BITMAP_BITS(info->i.layout.bitmap);
265 size = BITMAP_SIZE(info->i.layout.bitmap);
267 // NOTE: the payload starts immediately after the info-ptr, we
268 // don't have an StgHeader in the same sense as a heap closure.
270 if ((bitmap & 1) == 0) {
271 thread((StgClosure **)p);
274 bitmap = bitmap >> 1;
285 thread((StgClosure **)p);
287 size = BCO_BITMAP_SIZE(bco);
288 thread_large_bitmap(p, BCO_BITMAP(bco), size);
293 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
297 size = GET_LARGE_BITMAP(&info->i)->size;
298 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
304 StgRetFun *ret_fun = (StgRetFun *)p;
305 StgFunInfoTable *fun_info;
307 fun_info = itbl_to_fun_itbl(
308 get_threaded_info((StgPtr)ret_fun->fun));
309 // *before* threading it!
310 thread(&ret_fun->fun);
311 p = thread_arg_block(fun_info, ret_fun->payload);
316 barf("thread_stack: weird activation record found on stack: %d",
317 (int)(info->i.type));
323 thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
327 StgFunInfoTable *fun_info;
329 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)fun));
330 ASSERT(fun_info->i.type != PAP);
334 switch (fun_info->f.fun_type) {
336 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
339 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
343 thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
347 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
350 if ((bitmap & 1) == 0) {
351 thread((StgClosure **)p);
354 bitmap = bitmap >> 1;
364 thread_PAP (StgPAP *pap)
367 p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
373 thread_AP (StgAP *ap)
376 p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
382 thread_AP_STACK (StgAP_STACK *ap)
385 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
386 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
390 thread_TSO (StgTSO *tso)
393 thread_(&tso->global_link);
395 if ( tso->why_blocked == BlockedOnMVar
396 || tso->why_blocked == BlockedOnBlackHole
397 || tso->why_blocked == BlockedOnException
399 || tso->why_blocked == BlockedOnGA
400 || tso->why_blocked == BlockedOnGA_NoSend
403 thread_(&tso->block_info.closure);
405 if ( tso->blocked_exceptions != NULL ) {
406 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));
481 thread_obj (StgInfoTable *info, StgPtr p)
483 switch (info->type) {
485 return p + sizeofW(StgThunk) + 1;
489 return p + sizeofW(StgHeader) + 1;
493 thread(&((StgClosure *)p)->payload[0]);
494 return p + sizeofW(StgHeader) + 1;
497 thread(&((StgThunk *)p)->payload[0]);
498 return p + sizeofW(StgThunk) + 1;
501 return p + sizeofW(StgThunk) + 2;
505 return p + sizeofW(StgHeader) + 2;
508 thread(&((StgThunk *)p)->payload[0]);
509 return p + sizeofW(StgThunk) + 2;
513 thread(&((StgClosure *)p)->payload[0]);
514 return p + sizeofW(StgHeader) + 2;
517 thread(&((StgThunk *)p)->payload[0]);
518 thread(&((StgThunk *)p)->payload[1]);
519 return p + sizeofW(StgThunk) + 2;
523 thread(&((StgClosure *)p)->payload[0]);
524 thread(&((StgClosure *)p)->payload[1]);
525 return p + sizeofW(StgHeader) + 2;
528 StgBCO *bco = (StgBCO *)p;
529 thread_(&bco->instrs);
530 thread_(&bco->literals);
532 thread_(&bco->itbls);
533 return p + bco_sizeW(bco);
540 end = (P_)((StgThunk *)p)->payload +
541 info->layout.payload.ptrs;
542 for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
543 thread((StgClosure **)p);
545 return p + info->layout.payload.nptrs;
555 case SE_CAF_BLACKHOLE:
561 end = (P_)((StgClosure *)p)->payload +
562 info->layout.payload.ptrs;
563 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
564 thread((StgClosure **)p);
566 return p + info->layout.payload.nptrs;
571 StgWeak *w = (StgWeak *)p;
574 thread(&w->finalizer);
575 if (w->link != NULL) {
578 return p + sizeofW(StgWeak);
583 StgMVar *mvar = (StgMVar *)p;
584 thread_(&mvar->head);
585 thread_(&mvar->tail);
586 thread(&mvar->value);
587 return p + sizeofW(StgMVar);
591 case IND_OLDGEN_PERM:
592 thread(&((StgInd *)p)->indirectee);
593 return p + sizeofW(StgInd);
597 StgSelector *s = (StgSelector *)p;
598 thread(&s->selectee);
599 return p + THUNK_SELECTOR_sizeW();
603 return thread_AP_STACK((StgAP_STACK *)p);
606 return thread_PAP((StgPAP *)p);
609 return thread_AP((StgAP *)p);
612 return p + arr_words_sizeW((StgArrWords *)p);
614 case MUT_ARR_PTRS_CLEAN:
615 case MUT_ARR_PTRS_DIRTY:
616 case MUT_ARR_PTRS_FROZEN:
617 case MUT_ARR_PTRS_FROZEN0:
622 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
623 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
624 thread((StgClosure **)p);
630 return thread_TSO((StgTSO *)p);
632 case TVAR_WAIT_QUEUE:
634 StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p;
635 thread_(&wq->waiting_tso);
636 thread_(&wq->next_queue_entry);
637 thread_(&wq->prev_queue_entry);
638 return p + sizeofW(StgTVarWaitQueue);
643 StgTVar *tvar = (StgTVar *)p;
644 thread((void *)&tvar->current_value);
645 thread((void *)&tvar->first_wait_queue_entry);
646 return p + sizeofW(StgTVar);
651 StgTRecHeader *trec = (StgTRecHeader *)p;
652 thread_(&trec->enclosing_trec);
653 thread_(&trec->current_chunk);
654 return p + sizeofW(StgTRecHeader);
660 StgTRecChunk *tc = (StgTRecChunk *)p;
661 TRecEntry *e = &(tc -> entries[0]);
662 thread_(&tc->prev_chunk);
663 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
665 thread(&e->expected_value);
666 thread(&e->new_value);
668 return p + sizeofW(StgTRecChunk);
672 barf("update_fwd: unknown/strange object %d", (int)(info->type));
678 update_fwd( bdescr *blocks )
687 barf("update_fwd: ToDo");
690 // cycle through all the blocks in the step
691 for (; bd != NULL; bd = bd->link) {
694 // linearly scan the objects in this block
695 while (p < bd->free) {
696 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
697 info = get_itbl((StgClosure *)p);
698 p = thread_obj(info, p);
704 update_fwd_compact( bdescr *blocks )
710 bdescr *bd, *free_bd;
716 free = free_bd->start;
719 barf("update_fwd: ToDo");
722 // cycle through all the blocks in the step
723 for (; bd != NULL; bd = bd->link) {
726 while (p < bd->free ) {
728 while ( p < bd->free && !is_marked(p,bd) ) {
737 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
738 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
740 while ( p < bd->free ) {
745 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
753 // Problem: we need to know the destination for this cell
754 // in order to unthread its info pointer. But we can't
755 // know the destination without the size, because we may
756 // spill into the next block. So we have to run down the
757 // threaded list and get the info ptr first.
758 info = get_threaded_info(p);
762 p = thread_obj(info, p);
765 if (free + size > free_bd->start + BLOCK_SIZE_W) {
766 // unset the next bit in the bitmap to indicate that
767 // this object needs to be pushed into the next
768 // block. This saves us having to run down the
769 // threaded info pointer list twice during the next pass.
771 free_bd = free_bd->link;
772 free = free_bd->start;
774 ASSERT(is_marked(q+1,bd));
787 update_bkwd_compact( step *stp )
793 bdescr *bd, *free_bd;
795 nat size, free_blocks;
797 bd = free_bd = stp->old_blocks;
798 free = free_bd->start;
802 barf("update_bkwd: ToDo");
805 // cycle through all the blocks in the step
806 for (; bd != NULL; bd = bd->link) {
809 while (p < bd->free ) {
811 while ( p < bd->free && !is_marked(p,bd) ) {
820 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
821 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
823 while ( p < bd->free ) {
828 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
836 if (!is_marked(p+1,bd)) {
837 // don't forget to update the free ptr in the block desc.
838 free_bd->free = free;
839 free_bd = free_bd->link;
840 free = free_bd->start;
845 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
846 info = get_itbl((StgClosure *)p);
847 size = closure_sizeW_((StgClosure *)p,info);
854 if (info->type == TSO) {
855 move_TSO((StgTSO *)p, (StgTSO *)free);
866 // free the remaining blocks and count what's left.
867 free_bd->free = free;
868 if (free_bd->link != NULL) {
869 freeChain(free_bd->link);
870 free_bd->link = NULL;
877 compact( void (*get_roots)(evac_fn) )
882 // 1. thread the roots
883 get_roots((evac_fn)thread);
885 // the weak pointer lists...
886 if (weak_ptr_list != NULL) {
887 thread((void *)&weak_ptr_list);
889 if (old_weak_ptr_list != NULL) {
890 thread((void *)&old_weak_ptr_list); // tmp
894 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
897 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
898 for (p = bd->start; p < bd->free; p++) {
899 thread((StgClosure **)p);
904 // the global thread list
905 thread((void *)&all_threads);
907 // any threads resurrected during this GC
908 thread((void *)&resurrected_threads);
913 for (task = all_tasks; task != NULL; task = task->all_link) {
920 // the static objects
921 thread_static(scavenged_static_objects);
923 // the stable pointer table
924 threadStablePtrTable((evac_fn)thread);
926 // the CAF list (used by GHCi)
927 markCAFs((evac_fn)thread);
929 // 2. update forward ptrs
930 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
931 for (s = 0; s < generations[g].n_steps; s++) {
932 if (g==0 && s ==0) continue;
933 stp = &generations[g].steps[s];
934 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d\n", stp->gen->no, stp->no););
936 update_fwd(stp->blocks);
937 update_fwd_large(stp->scavenged_large_objects);
938 if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
939 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
940 update_fwd_compact(stp->old_blocks);
945 // 3. update backward ptrs
946 stp = &oldest_gen->steps[0];
947 if (stp->old_blocks != NULL) {
948 blocks = update_bkwd_compact(stp);
949 IF_DEBUG(gc, debugBelch("update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n",
950 stp->gen->no, stp->no,
951 stp->n_old_blocks, blocks););
952 stp->n_old_blocks = blocks;