1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team 2001
5 * Compacting garbage collector
7 * ---------------------------------------------------------------------------*/
9 #include "PosixSource.h"
14 #include "BlockAlloc.h"
16 #include "GCCompact.h"
20 // Turn off inlining when debugging - it obfuscates things
23 # define STATIC_INLINE static
26 /* -----------------------------------------------------------------------------
27 Threading / unthreading pointers.
29 The basic idea here is to chain together all the fields pointing at
30 a particular object, with the root of the chain in the object's
31 info table field. The original contents of the info pointer goes
32 at the end of the chain.
34 Adding a new field to the chain is a matter of swapping the
35 contents of the field with the contents of the object's info table
38 To unthread the chain, we walk down it updating all the fields on
39 the chain with the new location of the object. We stop when we
40 reach the info pointer at the end.
42 We use a trick to identify the info pointer: when swapping pointers
43 for threading, we set the low bit of the original pointer, with the
44 result that all the pointers in the chain have their low bits set
45 except for the info pointer.
46 -------------------------------------------------------------------------- */
51 StgPtr q = (StgPtr)*p;
54 // It doesn't look like a closure at the moment, because the info
55 // ptr is possibly threaded:
56 // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
58 if (HEAP_ALLOCED(q)) {
60 // a handy way to discover whether the ptr is into the
61 // compacted area of the old gen, is that the EVACUATED flag
62 // is zero (it's non-zero for all the other areas of live
64 if ((bd->flags & BF_EVACUATED) == 0) {
66 *q = (StgWord)p + 1; // set the low bit
72 unthread( StgPtr p, StgPtr free )
76 while ((q & 1) != 0) {
77 q -= 1; // unset the low bit again
79 *((StgPtr)q) = (StgWord)free;
85 STATIC_INLINE StgInfoTable *
86 get_threaded_info( StgPtr p )
88 StgPtr q = (P_)GET_INFO((StgClosure *)p);
90 while (((StgWord)q & 1) != 0) {
91 q = (P_)*((StgPtr)((StgWord)q-1));
94 ASSERT(LOOKS_LIKE_INFO_PTR(q));
95 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
98 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
99 // Remember, the two regions *might* overlap, but: to <= from.
101 move(StgPtr to, StgPtr from, nat size)
103 for(; size > 0; --size) {
109 obj_sizeW( StgClosure *p, StgInfoTable *info )
111 switch (info->type) {
116 return sizeofW(StgHeader) + 1;
128 return sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
130 return THUNK_SELECTOR_sizeW();
132 return ap_stack_sizeW((StgAP_STACK *)p);
135 return pap_sizeW((StgPAP *)p);
137 return arr_words_sizeW((StgArrWords *)p);
139 case MUT_ARR_PTRS_FROZEN:
140 return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
142 return tso_sizeW((StgTSO *)p);
144 return bco_sizeW((StgBCO *)p);
145 case TVAR_WAIT_QUEUE:
146 return sizeofW(StgTVarWaitQueue);
148 return sizeofW(StgTVar);
150 return sizeofW(StgTRecChunk);
152 return sizeofW(StgTRecHeader);
154 return sizeW_fromITBL(info);
159 thread_static( StgClosure* p )
161 const StgInfoTable *info;
163 // keep going until we've threaded all the objects on the linked
165 while (p != END_OF_STATIC_LIST) {
168 switch (info->type) {
171 thread((StgPtr)&((StgInd *)p)->indirectee);
172 p = IND_STATIC_LINK(p);
176 p = THUNK_STATIC_LINK(p);
179 p = FUN_STATIC_LINK(p);
182 p = STATIC_LINK(info,p);
186 barf("thread_static: strange closure %d", (int)(info->type));
193 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
199 bitmap = large_bitmap->bitmap[b];
200 for (i = 0; i < size; ) {
201 if ((bitmap & 1) == 0) {
206 if (i % BITS_IN(W_) == 0) {
208 bitmap = large_bitmap->bitmap[b];
210 bitmap = bitmap >> 1;
216 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
223 switch (fun_info->f.fun_type) {
225 bitmap = BITMAP_BITS(fun_info->f.bitmap);
226 size = BITMAP_SIZE(fun_info->f.bitmap);
229 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
230 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
234 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
235 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
238 if ((bitmap & 1) == 0) {
242 bitmap = bitmap >> 1;
251 thread_stack(StgPtr p, StgPtr stack_end)
253 const StgRetInfoTable* info;
257 // highly similar to scavenge_stack, but we do pointer threading here.
259 while (p < stack_end) {
261 // *p must be the info pointer of an activation
262 // record. All activation records have 'bitmap' style layout
265 info = get_ret_itbl((StgClosure *)p);
267 switch (info->i.type) {
269 // Dynamic bitmap: the mask is stored on the stack
273 dyn = ((StgRetDyn *)p)->liveness;
275 // traverse the bitmap first
276 bitmap = RET_DYN_LIVENESS(dyn);
277 p = (P_)&((StgRetDyn *)p)->payload[0];
278 size = RET_DYN_BITMAP_SIZE;
280 if ((bitmap & 1) == 0) {
284 bitmap = bitmap >> 1;
288 // skip over the non-ptr words
289 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
291 // follow the ptr words
292 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
299 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
300 case CATCH_RETRY_FRAME:
301 case CATCH_STM_FRAME:
302 case ATOMICALLY_FRAME:
308 bitmap = BITMAP_BITS(info->i.layout.bitmap);
309 size = BITMAP_SIZE(info->i.layout.bitmap);
311 // NOTE: the payload starts immediately after the info-ptr, we
312 // don't have an StgHeader in the same sense as a heap closure.
314 if ((bitmap & 1) == 0) {
318 bitmap = bitmap >> 1;
331 size = BCO_BITMAP_SIZE(bco);
332 thread_large_bitmap(p, BCO_BITMAP(bco), size);
337 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
341 size = GET_LARGE_BITMAP(&info->i)->size;
342 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
348 StgRetFun *ret_fun = (StgRetFun *)p;
349 StgFunInfoTable *fun_info;
351 fun_info = itbl_to_fun_itbl(
352 get_threaded_info((StgPtr)ret_fun->fun));
353 // *before* threading it!
354 thread((StgPtr)&ret_fun->fun);
355 p = thread_arg_block(fun_info, ret_fun->payload);
360 barf("thread_stack: weird activation record found on stack: %d",
361 (int)(info->i.type));
367 thread_PAP (StgPAP *pap)
370 StgWord bitmap, size;
371 StgFunInfoTable *fun_info;
373 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)pap->fun));
374 ASSERT(fun_info->i.type != PAP);
376 p = (StgPtr)pap->payload;
379 switch (fun_info->f.fun_type) {
381 bitmap = BITMAP_BITS(fun_info->f.bitmap);
384 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
388 thread_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun), size);
392 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
396 if ((bitmap & 1) == 0) {
400 bitmap = bitmap >> 1;
406 thread((StgPtr)&pap->fun);
411 thread_AP_STACK (StgAP_STACK *ap)
413 thread((StgPtr)&ap->fun);
414 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
415 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
419 thread_TSO (StgTSO *tso)
421 thread((StgPtr)&tso->link);
422 thread((StgPtr)&tso->global_link);
424 if ( tso->why_blocked == BlockedOnMVar
425 || tso->why_blocked == BlockedOnBlackHole
426 || tso->why_blocked == BlockedOnException
428 || tso->why_blocked == BlockedOnGA
429 || tso->why_blocked == BlockedOnGA_NoSend
432 thread((StgPtr)&tso->block_info.closure);
434 if ( tso->blocked_exceptions != NULL ) {
435 thread((StgPtr)&tso->blocked_exceptions);
438 thread((StgPtr)&tso->trec);
440 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
441 return (StgPtr)tso + tso_sizeW(tso);
446 update_fwd_large( bdescr *bd )
449 const StgInfoTable* info;
451 for (; bd != NULL; bd = bd->link) {
454 info = get_itbl((StgClosure *)p);
456 switch (info->type) {
463 case MUT_ARR_PTRS_FROZEN:
468 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
469 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
476 thread_TSO((StgTSO *)p);
480 thread_AP_STACK((StgAP_STACK *)p);
484 thread_PAP((StgPAP *)p);
488 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
494 thread_obj (StgInfoTable *info, StgPtr p)
496 switch (info->type) {
499 return p + sizeofW(StgHeader) + 1;
503 thread((StgPtr)&((StgClosure *)p)->payload[0]);
504 return p + sizeofW(StgHeader) + 1;
507 thread((StgPtr)&((StgClosure *)p)->payload[0]);
508 return p + sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
510 case THUNK_0_1: // MIN_UPD_SIZE
514 return p + sizeofW(StgHeader) + 2;
519 thread((StgPtr)&((StgClosure *)p)->payload[0]);
520 return p + sizeofW(StgHeader) + 2;
525 thread((StgPtr)&((StgClosure *)p)->payload[0]);
526 thread((StgPtr)&((StgClosure *)p)->payload[1]);
527 return p + sizeofW(StgHeader) + 2;
530 StgBCO *bco = (StgBCO *)p;
531 thread((StgPtr)&bco->instrs);
532 thread((StgPtr)&bco->literals);
533 thread((StgPtr)&bco->ptrs);
534 thread((StgPtr)&bco->itbls);
535 return p + bco_sizeW(bco);
546 case SE_CAF_BLACKHOLE:
553 end = (P_)((StgClosure *)p)->payload +
554 info->layout.payload.ptrs;
555 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
558 return p + info->layout.payload.nptrs;
563 StgWeak *w = (StgWeak *)p;
564 thread((StgPtr)&w->key);
565 thread((StgPtr)&w->value);
566 thread((StgPtr)&w->finalizer);
567 if (w->link != NULL) {
568 thread((StgPtr)&w->link);
570 return p + sizeofW(StgWeak);
575 StgMVar *mvar = (StgMVar *)p;
576 thread((StgPtr)&mvar->head);
577 thread((StgPtr)&mvar->tail);
578 thread((StgPtr)&mvar->value);
579 return p + sizeofW(StgMVar);
583 case IND_OLDGEN_PERM:
584 thread((StgPtr)&((StgInd *)p)->indirectee);
585 return p + sizeofW(StgInd);
589 StgSelector *s = (StgSelector *)p;
590 thread((StgPtr)&s->selectee);
591 return p + THUNK_SELECTOR_sizeW();
595 return thread_AP_STACK((StgAP_STACK *)p);
599 return thread_PAP((StgPAP *)p);
602 return p + arr_words_sizeW((StgArrWords *)p);
605 case MUT_ARR_PTRS_FROZEN:
610 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
611 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
618 return thread_TSO((StgTSO *)p);
620 case TVAR_WAIT_QUEUE:
622 StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p;
623 thread((StgPtr)&wq->waiting_tso);
624 thread((StgPtr)&wq->next_queue_entry);
625 thread((StgPtr)&wq->prev_queue_entry);
626 return p + sizeofW(StgTVarWaitQueue);
631 StgTVar *tvar = (StgTVar *)p;
632 thread((StgPtr)&tvar->current_value);
633 thread((StgPtr)&tvar->first_wait_queue_entry);
634 return p + sizeofW(StgTVar);
639 StgTRecHeader *trec = (StgTRecHeader *)p;
640 thread((StgPtr)&trec->enclosing_trec);
641 thread((StgPtr)&trec->current_chunk);
642 return p + sizeofW(StgTRecHeader);
648 StgTRecChunk *tc = (StgTRecChunk *)p;
649 TRecEntry *e = &(tc -> entries[0]);
650 thread((StgPtr)&tc->prev_chunk);
651 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
652 thread((StgPtr)&e->tvar);
653 thread((StgPtr)&e->expected_value);
654 thread((StgPtr)&e->new_value);
656 return p + sizeofW(StgTRecChunk);
660 barf("update_fwd: unknown/strange object %d", (int)(info->type));
666 update_fwd( bdescr *blocks )
675 barf("update_fwd: ToDo");
678 // cycle through all the blocks in the step
679 for (; bd != NULL; bd = bd->link) {
682 // linearly scan the objects in this block
683 while (p < bd->free) {
684 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
685 info = get_itbl((StgClosure *)p);
686 p = thread_obj(info, p);
692 update_fwd_compact( bdescr *blocks )
698 bdescr *bd, *free_bd;
704 free = free_bd->start;
707 barf("update_fwd: ToDo");
710 // cycle through all the blocks in the step
711 for (; bd != NULL; bd = bd->link) {
714 while (p < bd->free ) {
716 while ( p < bd->free && !is_marked(p,bd) ) {
725 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
726 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
728 while ( p < bd->free ) {
733 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
741 // Problem: we need to know the destination for this cell
742 // in order to unthread its info pointer. But we can't
743 // know the destination without the size, because we may
744 // spill into the next block. So we have to run down the
745 // threaded list and get the info ptr first.
746 info = get_threaded_info(p);
750 p = thread_obj(info, p);
753 if (free + size > free_bd->start + BLOCK_SIZE_W) {
754 // unset the next bit in the bitmap to indicate that
755 // this object needs to be pushed into the next
756 // block. This saves us having to run down the
757 // threaded info pointer list twice during the next pass.
759 free_bd = free_bd->link;
760 free = free_bd->start;
762 ASSERT(is_marked(q+1,bd));
775 update_bkwd_compact( step *stp )
781 bdescr *bd, *free_bd;
783 nat size, free_blocks;
785 bd = free_bd = stp->blocks;
786 free = free_bd->start;
790 barf("update_bkwd: ToDo");
793 // cycle through all the blocks in the step
794 for (; bd != NULL; bd = bd->link) {
797 while (p < bd->free ) {
799 while ( p < bd->free && !is_marked(p,bd) ) {
808 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
809 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
811 while ( p < bd->free ) {
816 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
824 if (!is_marked(p+1,bd)) {
825 // don't forget to update the free ptr in the block desc.
826 free_bd->free = free;
827 free_bd = free_bd->link;
828 free = free_bd->start;
833 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
834 info = get_itbl((StgClosure *)p);
835 size = obj_sizeW((StgClosure *)p,info);
841 // Rebuild the mutable list for the old generation.
842 if (ip_MUTABLE(info)) {
843 recordMutable((StgClosure *)free);
847 if (info->type == TSO) {
848 move_TSO((StgTSO *)p, (StgTSO *)free);
859 // free the remaining blocks and count what's left.
860 free_bd->free = free;
861 if (free_bd->link != NULL) {
862 freeChain(free_bd->link);
863 free_bd->link = NULL;
865 stp->n_blocks = free_blocks;
871 compact( void (*get_roots)(evac_fn) )
876 // 1. thread the roots
877 get_roots((evac_fn)thread);
879 // the weak pointer lists...
880 if (weak_ptr_list != NULL) {
881 thread((StgPtr)&weak_ptr_list);
883 if (old_weak_ptr_list != NULL) {
884 thread((StgPtr)&old_weak_ptr_list); // tmp
888 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
891 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
892 for (p = bd->start; p < bd->free; p++) {
898 // the global thread list
899 thread((StgPtr)&all_threads);
901 // any threads resurrected during this GC
902 thread((StgPtr)&resurrected_threads);
904 // the main threads list
907 for (m = main_threads; m != NULL; m = m->link) {
908 thread((StgPtr)&m->tso);
912 // the static objects
913 thread_static(scavenged_static_objects);
915 // the stable pointer table
916 threadStablePtrTable((evac_fn)thread);
918 // the CAF list (used by GHCi)
919 markCAFs((evac_fn)thread);
921 // 2. update forward ptrs
922 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
923 for (s = 0; s < generations[g].n_steps; s++) {
924 stp = &generations[g].steps[s];
925 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d\n", stp->gen->no, stp->no););
927 update_fwd(stp->to_blocks);
928 update_fwd_large(stp->scavenged_large_objects);
929 if (g == RtsFlags.GcFlags.generations-1 && stp->blocks != NULL) {
930 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
931 update_fwd_compact(stp->blocks);
936 // 3. update backward ptrs
937 stp = &oldest_gen->steps[0];
938 if (stp->blocks != NULL) {
939 blocks = update_bkwd_compact(stp);
940 IF_DEBUG(gc, debugBelch("update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n",
941 stp->gen->no, stp->no,
942 stp->n_blocks, blocks););
943 stp->n_blocks = blocks;