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);
547 case SE_CAF_BLACKHOLE:
554 end = (P_)((StgClosure *)p)->payload +
555 info->layout.payload.ptrs;
556 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
559 return p + info->layout.payload.nptrs;
564 StgWeak *w = (StgWeak *)p;
565 thread((StgPtr)&w->key);
566 thread((StgPtr)&w->value);
567 thread((StgPtr)&w->finalizer);
568 if (w->link != NULL) {
569 thread((StgPtr)&w->link);
571 return p + sizeofW(StgWeak);
576 StgMVar *mvar = (StgMVar *)p;
577 thread((StgPtr)&mvar->head);
578 thread((StgPtr)&mvar->tail);
579 thread((StgPtr)&mvar->value);
580 return p + sizeofW(StgMVar);
584 case IND_OLDGEN_PERM:
585 thread((StgPtr)&((StgIndOldGen *)p)->indirectee);
586 return p + sizeofW(StgIndOldGen);
590 StgSelector *s = (StgSelector *)p;
591 thread((StgPtr)&s->selectee);
592 return p + THUNK_SELECTOR_sizeW();
596 return thread_AP_STACK((StgAP_STACK *)p);
600 return thread_PAP((StgPAP *)p);
603 return p + arr_words_sizeW((StgArrWords *)p);
606 case MUT_ARR_PTRS_FROZEN:
611 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
612 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
619 return thread_TSO((StgTSO *)p);
621 case TVAR_WAIT_QUEUE:
623 StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p;
624 thread((StgPtr)&wq->waiting_tso);
625 thread((StgPtr)&wq->next_queue_entry);
626 thread((StgPtr)&wq->prev_queue_entry);
627 return p + sizeofW(StgTVarWaitQueue);
632 StgTVar *tvar = (StgTVar *)p;
633 thread((StgPtr)&tvar->current_value);
634 thread((StgPtr)&tvar->first_wait_queue_entry);
635 return p + sizeofW(StgTVar);
640 StgTRecHeader *trec = (StgTRecHeader *)p;
641 thread((StgPtr)&trec->enclosing_trec);
642 thread((StgPtr)&trec->current_chunk);
643 return p + sizeofW(StgTRecHeader);
649 StgTRecChunk *tc = (StgTRecChunk *)p;
650 TRecEntry *e = &(tc -> entries[0]);
651 thread((StgPtr)&tc->prev_chunk);
652 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
653 thread((StgPtr)&e->tvar);
654 thread((StgPtr)&e->expected_value);
655 thread((StgPtr)&e->new_value);
657 return p + sizeofW(StgTRecChunk);
661 barf("update_fwd: unknown/strange object %d", (int)(info->type));
667 update_fwd( bdescr *blocks )
676 barf("update_fwd: ToDo");
679 // cycle through all the blocks in the step
680 for (; bd != NULL; bd = bd->link) {
683 // linearly scan the objects in this block
684 while (p < bd->free) {
685 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
686 info = get_itbl((StgClosure *)p);
687 p = thread_obj(info, p);
693 update_fwd_compact( bdescr *blocks )
699 bdescr *bd, *free_bd;
705 free = free_bd->start;
708 barf("update_fwd: ToDo");
711 // cycle through all the blocks in the step
712 for (; bd != NULL; bd = bd->link) {
715 while (p < bd->free ) {
717 while ( p < bd->free && !is_marked(p,bd) ) {
726 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
727 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
729 while ( p < bd->free ) {
734 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
742 // Problem: we need to know the destination for this cell
743 // in order to unthread its info pointer. But we can't
744 // know the destination without the size, because we may
745 // spill into the next block. So we have to run down the
746 // threaded list and get the info ptr first.
747 info = get_threaded_info(p);
751 p = thread_obj(info, p);
754 if (free + size > free_bd->start + BLOCK_SIZE_W) {
755 // unset the next bit in the bitmap to indicate that
756 // this object needs to be pushed into the next
757 // block. This saves us having to run down the
758 // threaded info pointer list twice during the next pass.
760 free_bd = free_bd->link;
761 free = free_bd->start;
763 ASSERT(is_marked(q+1,bd));
776 update_bkwd_compact( step *stp )
782 bdescr *bd, *free_bd;
784 nat size, free_blocks;
786 bd = free_bd = stp->blocks;
787 free = free_bd->start;
791 barf("update_bkwd: ToDo");
794 // cycle through all the blocks in the step
795 for (; bd != NULL; bd = bd->link) {
798 while (p < bd->free ) {
800 while ( p < bd->free && !is_marked(p,bd) ) {
809 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
810 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
812 while ( p < bd->free ) {
817 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
825 if (!is_marked(p+1,bd)) {
826 // don't forget to update the free ptr in the block desc.
827 free_bd->free = free;
828 free_bd = free_bd->link;
829 free = free_bd->start;
834 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
835 info = get_itbl((StgClosure *)p);
836 size = obj_sizeW((StgClosure *)p,info);
842 // Rebuild the mutable list for the old generation.
843 if (ip_MUTABLE(info)) {
844 recordMutable((StgMutClosure *)free);
848 if (info->type == TSO) {
849 move_TSO((StgTSO *)p, (StgTSO *)free);
860 // free the remaining blocks and count what's left.
861 free_bd->free = free;
862 if (free_bd->link != NULL) {
863 freeChain(free_bd->link);
864 free_bd->link = NULL;
866 stp->n_blocks = free_blocks;
872 thread_mut_once_list( generation *g )
874 StgMutClosure *p, *next;
876 for (p = g->mut_once_list; p != END_MUT_LIST; p = next) {
878 thread((StgPtr)&p->mut_link);
881 thread((StgPtr)&g->mut_once_list);
885 compact( void (*get_roots)(evac_fn) )
890 // 1. thread the roots
891 get_roots((evac_fn)thread);
893 // the weak pointer lists...
894 if (weak_ptr_list != NULL) {
895 thread((StgPtr)&weak_ptr_list);
897 if (old_weak_ptr_list != NULL) {
898 thread((StgPtr)&old_weak_ptr_list); // tmp
902 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
903 thread((StgPtr)&generations[g].mut_list);
904 thread_mut_once_list(&generations[g]);
907 // the global thread list
908 thread((StgPtr)&all_threads);
910 // any threads resurrected during this GC
911 thread((StgPtr)&resurrected_threads);
913 // the main threads list
916 for (m = main_threads; m != NULL; m = m->link) {
917 thread((StgPtr)&m->tso);
921 // the static objects
922 thread_static(scavenged_static_objects);
924 // the stable pointer table
925 threadStablePtrTable((evac_fn)thread);
927 // the CAF list (used by GHCi)
928 markCAFs((evac_fn)thread);
930 // 2. update forward ptrs
931 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
932 for (s = 0; s < generations[g].n_steps; s++) {
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->to_blocks);
937 update_fwd_large(stp->scavenged_large_objects);
938 if (g == RtsFlags.GcFlags.generations-1 && stp->blocks != NULL) {
939 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
940 update_fwd_compact(stp->blocks);
945 // 3. update backward ptrs
946 stp = &oldest_gen->steps[0];
947 if (stp->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_blocks, blocks););
952 stp->n_blocks = blocks;