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 -------------------------------------------------------------------------- */
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 *q = (StgWord)p + 1; // set the low bit
73 unthread( StgPtr p, StgPtr free )
77 while ((q & 1) != 0) {
78 q -= 1; // unset the low bit again
80 *((StgPtr)q) = (StgWord)free;
86 STATIC_INLINE StgInfoTable *
87 get_threaded_info( StgPtr p )
89 StgPtr q = (P_)GET_INFO((StgClosure *)p);
91 while (((StgWord)q & 1) != 0) {
92 q = (P_)*((StgPtr)((StgWord)q-1));
95 ASSERT(LOOKS_LIKE_INFO_PTR(q));
96 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
99 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
100 // Remember, the two regions *might* overlap, but: to <= from.
102 move(StgPtr to, StgPtr from, nat size)
104 for(; size > 0; --size) {
110 obj_sizeW( StgClosure *p, StgInfoTable *info )
112 switch (info->type) {
115 return sizeofW(StgThunk) + 1;
120 return sizeofW(StgHeader) + 1;
124 return sizeofW(StgThunk) + 2;
131 return sizeofW(StgHeader) + 2;
133 return THUNK_SELECTOR_sizeW();
135 return ap_stack_sizeW((StgAP_STACK *)p);
138 return pap_sizeW((StgPAP *)p);
140 return arr_words_sizeW((StgArrWords *)p);
141 case MUT_ARR_PTRS_CLEAN:
142 case MUT_ARR_PTRS_DIRTY:
143 case MUT_ARR_PTRS_FROZEN:
144 case MUT_ARR_PTRS_FROZEN0:
145 return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
147 return tso_sizeW((StgTSO *)p);
149 return bco_sizeW((StgBCO *)p);
150 case TVAR_WAIT_QUEUE:
151 return sizeofW(StgTVarWaitQueue);
153 return sizeofW(StgTVar);
155 return sizeofW(StgTRecChunk);
157 return sizeofW(StgTRecHeader);
159 return sizeW_fromITBL(info);
164 thread_static( StgClosure* p )
166 const StgInfoTable *info;
168 // keep going until we've threaded all the objects on the linked
170 while (p != END_OF_STATIC_LIST) {
173 switch (info->type) {
176 thread((StgPtr)&((StgInd *)p)->indirectee);
177 p = *IND_STATIC_LINK(p);
181 p = *THUNK_STATIC_LINK(p);
184 p = *FUN_STATIC_LINK(p);
187 p = *STATIC_LINK(info,p);
191 barf("thread_static: strange closure %d", (int)(info->type));
198 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
204 bitmap = large_bitmap->bitmap[b];
205 for (i = 0; i < size; ) {
206 if ((bitmap & 1) == 0) {
211 if (i % BITS_IN(W_) == 0) {
213 bitmap = large_bitmap->bitmap[b];
215 bitmap = bitmap >> 1;
221 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
228 switch (fun_info->f.fun_type) {
230 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
231 size = BITMAP_SIZE(fun_info->f.b.bitmap);
234 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
235 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
239 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
240 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
243 if ((bitmap & 1) == 0) {
247 bitmap = bitmap >> 1;
256 thread_stack(StgPtr p, StgPtr stack_end)
258 const StgRetInfoTable* info;
262 // highly similar to scavenge_stack, but we do pointer threading here.
264 while (p < stack_end) {
266 // *p must be the info pointer of an activation
267 // record. All activation records have 'bitmap' style layout
270 info = get_ret_itbl((StgClosure *)p);
272 switch (info->i.type) {
274 // Dynamic bitmap: the mask is stored on the stack
278 dyn = ((StgRetDyn *)p)->liveness;
280 // traverse the bitmap first
281 bitmap = RET_DYN_LIVENESS(dyn);
282 p = (P_)&((StgRetDyn *)p)->payload[0];
283 size = RET_DYN_BITMAP_SIZE;
285 if ((bitmap & 1) == 0) {
289 bitmap = bitmap >> 1;
293 // skip over the non-ptr words
294 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
296 // follow the ptr words
297 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
304 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
305 case CATCH_RETRY_FRAME:
306 case CATCH_STM_FRAME:
307 case ATOMICALLY_FRAME:
313 bitmap = BITMAP_BITS(info->i.layout.bitmap);
314 size = BITMAP_SIZE(info->i.layout.bitmap);
316 // NOTE: the payload starts immediately after the info-ptr, we
317 // don't have an StgHeader in the same sense as a heap closure.
319 if ((bitmap & 1) == 0) {
323 bitmap = bitmap >> 1;
336 size = BCO_BITMAP_SIZE(bco);
337 thread_large_bitmap(p, BCO_BITMAP(bco), size);
342 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
346 size = GET_LARGE_BITMAP(&info->i)->size;
347 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
353 StgRetFun *ret_fun = (StgRetFun *)p;
354 StgFunInfoTable *fun_info;
356 fun_info = itbl_to_fun_itbl(
357 get_threaded_info((StgPtr)ret_fun->fun));
358 // *before* threading it!
359 thread((StgPtr)&ret_fun->fun);
360 p = thread_arg_block(fun_info, ret_fun->payload);
365 barf("thread_stack: weird activation record found on stack: %d",
366 (int)(info->i.type));
372 thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
376 StgFunInfoTable *fun_info;
378 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)fun));
379 ASSERT(fun_info->i.type != PAP);
383 switch (fun_info->f.fun_type) {
385 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
388 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
392 thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
396 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
399 if ((bitmap & 1) == 0) {
403 bitmap = bitmap >> 1;
413 thread_PAP (StgPAP *pap)
416 p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
417 thread((StgPtr)&pap->fun);
422 thread_AP (StgAP *ap)
425 p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
426 thread((StgPtr)&ap->fun);
431 thread_AP_STACK (StgAP_STACK *ap)
433 thread((StgPtr)&ap->fun);
434 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
435 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
439 thread_TSO (StgTSO *tso)
441 thread((StgPtr)&tso->link);
442 thread((StgPtr)&tso->global_link);
444 if ( tso->why_blocked == BlockedOnMVar
445 || tso->why_blocked == BlockedOnBlackHole
446 || tso->why_blocked == BlockedOnException
448 || tso->why_blocked == BlockedOnGA
449 || tso->why_blocked == BlockedOnGA_NoSend
452 thread((StgPtr)&tso->block_info.closure);
454 if ( tso->blocked_exceptions != NULL ) {
455 thread((StgPtr)&tso->blocked_exceptions);
458 thread((StgPtr)&tso->trec);
460 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
461 return (StgPtr)tso + tso_sizeW(tso);
466 update_fwd_large( bdescr *bd )
469 const StgInfoTable* info;
471 for (; bd != NULL; bd = bd->link) {
474 info = get_itbl((StgClosure *)p);
476 switch (info->type) {
482 case MUT_ARR_PTRS_CLEAN:
483 case MUT_ARR_PTRS_DIRTY:
484 case MUT_ARR_PTRS_FROZEN:
485 case MUT_ARR_PTRS_FROZEN0:
490 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
491 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
498 thread_TSO((StgTSO *)p);
502 thread_AP_STACK((StgAP_STACK *)p);
506 thread_PAP((StgPAP *)p);
512 StgTRecChunk *tc = (StgTRecChunk *)p;
513 TRecEntry *e = &(tc -> entries[0]);
514 thread((StgPtr)&tc->prev_chunk);
515 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
516 thread((StgPtr)&e->tvar);
517 thread((StgPtr)&e->expected_value);
518 thread((StgPtr)&e->new_value);
524 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
530 thread_obj (StgInfoTable *info, StgPtr p)
532 switch (info->type) {
534 return p + sizeofW(StgThunk) + 1;
538 return p + sizeofW(StgHeader) + 1;
542 thread((StgPtr)&((StgClosure *)p)->payload[0]);
543 return p + sizeofW(StgHeader) + 1;
546 thread((StgPtr)&((StgThunk *)p)->payload[0]);
547 return p + sizeofW(StgThunk) + 1;
550 return p + sizeofW(StgThunk) + 2;
554 return p + sizeofW(StgHeader) + 2;
557 thread((StgPtr)&((StgThunk *)p)->payload[0]);
558 return p + sizeofW(StgThunk) + 2;
562 thread((StgPtr)&((StgClosure *)p)->payload[0]);
563 return p + sizeofW(StgHeader) + 2;
566 thread((StgPtr)&((StgThunk *)p)->payload[0]);
567 thread((StgPtr)&((StgThunk *)p)->payload[1]);
568 return p + sizeofW(StgThunk) + 2;
572 thread((StgPtr)&((StgClosure *)p)->payload[0]);
573 thread((StgPtr)&((StgClosure *)p)->payload[1]);
574 return p + sizeofW(StgHeader) + 2;
577 StgBCO *bco = (StgBCO *)p;
578 thread((StgPtr)&bco->instrs);
579 thread((StgPtr)&bco->literals);
580 thread((StgPtr)&bco->ptrs);
581 thread((StgPtr)&bco->itbls);
582 return p + bco_sizeW(bco);
589 end = (P_)((StgThunk *)p)->payload +
590 info->layout.payload.ptrs;
591 for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
594 return p + info->layout.payload.nptrs;
604 case SE_CAF_BLACKHOLE:
610 end = (P_)((StgClosure *)p)->payload +
611 info->layout.payload.ptrs;
612 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
615 return p + info->layout.payload.nptrs;
620 StgWeak *w = (StgWeak *)p;
621 thread((StgPtr)&w->key);
622 thread((StgPtr)&w->value);
623 thread((StgPtr)&w->finalizer);
624 if (w->link != NULL) {
625 thread((StgPtr)&w->link);
627 return p + sizeofW(StgWeak);
632 StgMVar *mvar = (StgMVar *)p;
633 thread((StgPtr)&mvar->head);
634 thread((StgPtr)&mvar->tail);
635 thread((StgPtr)&mvar->value);
636 return p + sizeofW(StgMVar);
640 case IND_OLDGEN_PERM:
641 thread((StgPtr)&((StgInd *)p)->indirectee);
642 return p + sizeofW(StgInd);
646 StgSelector *s = (StgSelector *)p;
647 thread((StgPtr)&s->selectee);
648 return p + THUNK_SELECTOR_sizeW();
652 return thread_AP_STACK((StgAP_STACK *)p);
655 return thread_PAP((StgPAP *)p);
658 return thread_AP((StgAP *)p);
661 return p + arr_words_sizeW((StgArrWords *)p);
663 case MUT_ARR_PTRS_CLEAN:
664 case MUT_ARR_PTRS_DIRTY:
665 case MUT_ARR_PTRS_FROZEN:
666 case MUT_ARR_PTRS_FROZEN0:
671 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
672 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
679 return thread_TSO((StgTSO *)p);
681 case TVAR_WAIT_QUEUE:
683 StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p;
684 thread((StgPtr)&wq->waiting_tso);
685 thread((StgPtr)&wq->next_queue_entry);
686 thread((StgPtr)&wq->prev_queue_entry);
687 return p + sizeofW(StgTVarWaitQueue);
692 StgTVar *tvar = (StgTVar *)p;
693 thread((StgPtr)&tvar->current_value);
694 thread((StgPtr)&tvar->first_wait_queue_entry);
695 return p + sizeofW(StgTVar);
700 StgTRecHeader *trec = (StgTRecHeader *)p;
701 thread((StgPtr)&trec->enclosing_trec);
702 thread((StgPtr)&trec->current_chunk);
703 return p + sizeofW(StgTRecHeader);
709 StgTRecChunk *tc = (StgTRecChunk *)p;
710 TRecEntry *e = &(tc -> entries[0]);
711 thread((StgPtr)&tc->prev_chunk);
712 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
713 thread((StgPtr)&e->tvar);
714 thread((StgPtr)&e->expected_value);
715 thread((StgPtr)&e->new_value);
717 return p + sizeofW(StgTRecChunk);
721 barf("update_fwd: unknown/strange object %d", (int)(info->type));
727 update_fwd( bdescr *blocks )
736 barf("update_fwd: ToDo");
739 // cycle through all the blocks in the step
740 for (; bd != NULL; bd = bd->link) {
743 // linearly scan the objects in this block
744 while (p < bd->free) {
745 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
746 info = get_itbl((StgClosure *)p);
747 p = thread_obj(info, p);
753 update_fwd_compact( bdescr *blocks )
759 bdescr *bd, *free_bd;
765 free = free_bd->start;
768 barf("update_fwd: ToDo");
771 // cycle through all the blocks in the step
772 for (; bd != NULL; bd = bd->link) {
775 while (p < bd->free ) {
777 while ( p < bd->free && !is_marked(p,bd) ) {
786 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
787 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
789 while ( p < bd->free ) {
794 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
802 // Problem: we need to know the destination for this cell
803 // in order to unthread its info pointer. But we can't
804 // know the destination without the size, because we may
805 // spill into the next block. So we have to run down the
806 // threaded list and get the info ptr first.
807 info = get_threaded_info(p);
811 p = thread_obj(info, p);
814 if (free + size > free_bd->start + BLOCK_SIZE_W) {
815 // unset the next bit in the bitmap to indicate that
816 // this object needs to be pushed into the next
817 // block. This saves us having to run down the
818 // threaded info pointer list twice during the next pass.
820 free_bd = free_bd->link;
821 free = free_bd->start;
823 ASSERT(is_marked(q+1,bd));
836 update_bkwd_compact( step *stp )
842 bdescr *bd, *free_bd;
844 nat size, free_blocks;
846 bd = free_bd = stp->old_blocks;
847 free = free_bd->start;
851 barf("update_bkwd: ToDo");
854 // cycle through all the blocks in the step
855 for (; bd != NULL; bd = bd->link) {
858 while (p < bd->free ) {
860 while ( p < bd->free && !is_marked(p,bd) ) {
869 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
870 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
872 while ( p < bd->free ) {
877 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
885 if (!is_marked(p+1,bd)) {
886 // don't forget to update the free ptr in the block desc.
887 free_bd->free = free;
888 free_bd = free_bd->link;
889 free = free_bd->start;
894 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
895 info = get_itbl((StgClosure *)p);
896 size = obj_sizeW((StgClosure *)p,info);
903 if (info->type == TSO) {
904 move_TSO((StgTSO *)p, (StgTSO *)free);
915 // free the remaining blocks and count what's left.
916 free_bd->free = free;
917 if (free_bd->link != NULL) {
918 freeChain(free_bd->link);
919 free_bd->link = NULL;
926 compact( void (*get_roots)(evac_fn) )
931 // 1. thread the roots
932 get_roots((evac_fn)thread);
934 // the weak pointer lists...
935 if (weak_ptr_list != NULL) {
936 thread((StgPtr)(void *)&weak_ptr_list);
938 if (old_weak_ptr_list != NULL) {
939 thread((StgPtr)(void *)&old_weak_ptr_list); // tmp
943 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
946 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
947 for (p = bd->start; p < bd->free; p++) {
953 // the global thread list
954 thread((StgPtr)(void *)&all_threads);
956 // any threads resurrected during this GC
957 thread((StgPtr)(void *)&resurrected_threads);
962 for (task = all_tasks; task != NULL; task = task->all_link) {
964 thread((StgPtr)&task->tso);
969 // the static objects
970 thread_static(scavenged_static_objects);
972 // the stable pointer table
973 threadStablePtrTable((evac_fn)thread);
975 // the CAF list (used by GHCi)
976 markCAFs((evac_fn)thread);
978 // 2. update forward ptrs
979 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
980 for (s = 0; s < generations[g].n_steps; s++) {
981 if (g==0 && s ==0) continue;
982 stp = &generations[g].steps[s];
983 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d\n", stp->gen->no, stp->no););
985 update_fwd(stp->blocks);
986 update_fwd_large(stp->scavenged_large_objects);
987 if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
988 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
989 update_fwd_compact(stp->old_blocks);
994 // 3. update backward ptrs
995 stp = &oldest_gen->steps[0];
996 if (stp->old_blocks != NULL) {
997 blocks = update_bkwd_compact(stp);
998 IF_DEBUG(gc, debugBelch("update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n",
999 stp->gen->no, stp->no,
1000 stp->n_old_blocks, blocks););
1001 stp->n_old_blocks = blocks;