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);
146 return sizeW_fromITBL(info);
151 thread_static( StgClosure* p )
153 const StgInfoTable *info;
155 // keep going until we've threaded all the objects on the linked
157 while (p != END_OF_STATIC_LIST) {
160 switch (info->type) {
163 thread((StgPtr)&((StgInd *)p)->indirectee);
164 p = IND_STATIC_LINK(p);
168 p = THUNK_STATIC_LINK(p);
171 p = FUN_STATIC_LINK(p);
174 p = STATIC_LINK(info,p);
178 barf("thread_static: strange closure %d", (int)(info->type));
185 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
191 bitmap = large_bitmap->bitmap[b];
192 for (i = 0; i < size; ) {
193 if ((bitmap & 1) == 0) {
198 if (i % BITS_IN(W_) == 0) {
200 bitmap = large_bitmap->bitmap[b];
202 bitmap = bitmap >> 1;
208 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
215 switch (fun_info->f.fun_type) {
217 bitmap = BITMAP_BITS(fun_info->f.bitmap);
218 size = BITMAP_SIZE(fun_info->f.bitmap);
221 size = ((StgLargeBitmap *)fun_info->f.bitmap)->size;
222 thread_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap, size);
226 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
227 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
230 if ((bitmap & 1) == 0) {
234 bitmap = bitmap >> 1;
243 thread_stack(StgPtr p, StgPtr stack_end)
245 const StgRetInfoTable* info;
249 // highly similar to scavenge_stack, but we do pointer threading here.
251 while (p < stack_end) {
253 // *p must be the info pointer of an activation
254 // record. All activation records have 'bitmap' style layout
257 info = get_ret_itbl((StgClosure *)p);
259 switch (info->i.type) {
261 // Dynamic bitmap: the mask is stored on the stack
265 dyn = ((StgRetDyn *)p)->liveness;
267 // traverse the bitmap first
268 bitmap = RET_DYN_LIVENESS(dyn);
269 p = (P_)&((StgRetDyn *)p)->payload[0];
270 size = RET_DYN_BITMAP_SIZE;
272 if ((bitmap & 1) == 0) {
276 bitmap = bitmap >> 1;
280 // skip over the non-ptr words
281 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
283 // follow the ptr words
284 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
291 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
297 bitmap = BITMAP_BITS(info->i.layout.bitmap);
298 size = BITMAP_SIZE(info->i.layout.bitmap);
300 // NOTE: the payload starts immediately after the info-ptr, we
301 // don't have an StgHeader in the same sense as a heap closure.
303 if ((bitmap & 1) == 0) {
307 bitmap = bitmap >> 1;
320 size = BCO_BITMAP_SIZE(bco);
321 thread_large_bitmap(p, BCO_BITMAP(bco), size);
326 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
330 size = info->i.layout.large_bitmap->size;
331 thread_large_bitmap(p, info->i.layout.large_bitmap, size);
337 StgRetFun *ret_fun = (StgRetFun *)p;
338 StgFunInfoTable *fun_info;
340 fun_info = itbl_to_fun_itbl(
341 get_threaded_info((StgPtr)ret_fun->fun));
342 // *before* threading it!
343 thread((StgPtr)&ret_fun->fun);
344 p = thread_arg_block(fun_info, ret_fun->payload);
349 barf("thread_stack: weird activation record found on stack: %d",
350 (int)(info->i.type));
356 thread_PAP (StgPAP *pap)
359 StgWord bitmap, size;
360 StgFunInfoTable *fun_info;
362 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)pap->fun));
363 ASSERT(fun_info->i.type != PAP);
365 p = (StgPtr)pap->payload;
368 switch (fun_info->f.fun_type) {
370 bitmap = BITMAP_BITS(fun_info->f.bitmap);
373 thread_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap, size);
377 thread_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun), size);
381 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
385 if ((bitmap & 1) == 0) {
389 bitmap = bitmap >> 1;
395 thread((StgPtr)&pap->fun);
400 thread_AP_STACK (StgAP_STACK *ap)
402 thread((StgPtr)&ap->fun);
403 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
404 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
408 thread_TSO (StgTSO *tso)
410 thread((StgPtr)&tso->link);
411 thread((StgPtr)&tso->global_link);
413 if ( tso->why_blocked == BlockedOnMVar
414 || tso->why_blocked == BlockedOnBlackHole
415 || tso->why_blocked == BlockedOnException
417 || tso->why_blocked == BlockedOnGA
418 || tso->why_blocked == BlockedOnGA_NoSend
421 thread((StgPtr)&tso->block_info.closure);
423 if ( tso->blocked_exceptions != NULL ) {
424 thread((StgPtr)&tso->blocked_exceptions);
427 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
428 return (StgPtr)tso + tso_sizeW(tso);
433 update_fwd_large( bdescr *bd )
436 const StgInfoTable* info;
438 for (; bd != NULL; bd = bd->link) {
441 info = get_itbl((StgClosure *)p);
443 switch (info->type) {
450 case MUT_ARR_PTRS_FROZEN:
455 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
456 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
463 thread_TSO((StgTSO *)p);
467 thread_AP_STACK((StgAP_STACK *)p);
471 thread_PAP((StgPAP *)p);
475 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
481 thread_obj (StgInfoTable *info, StgPtr p)
483 switch (info->type) {
486 return p + sizeofW(StgHeader) + 1;
490 thread((StgPtr)&((StgClosure *)p)->payload[0]);
491 return p + sizeofW(StgHeader) + 1;
494 thread((StgPtr)&((StgClosure *)p)->payload[0]);
495 return p + sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
497 case THUNK_0_1: // MIN_UPD_SIZE
501 return p + sizeofW(StgHeader) + 2;
506 thread((StgPtr)&((StgClosure *)p)->payload[0]);
507 return p + sizeofW(StgHeader) + 2;
512 thread((StgPtr)&((StgClosure *)p)->payload[0]);
513 thread((StgPtr)&((StgClosure *)p)->payload[1]);
514 return p + sizeofW(StgHeader) + 2;
517 StgBCO *bco = (StgBCO *)p;
518 thread((StgPtr)&bco->instrs);
519 thread((StgPtr)&bco->literals);
520 thread((StgPtr)&bco->ptrs);
521 thread((StgPtr)&bco->itbls);
522 return p + bco_sizeW(bco);
534 case SE_CAF_BLACKHOLE:
541 end = (P_)((StgClosure *)p)->payload +
542 info->layout.payload.ptrs;
543 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
546 return p + info->layout.payload.nptrs;
551 StgWeak *w = (StgWeak *)p;
552 thread((StgPtr)&w->key);
553 thread((StgPtr)&w->value);
554 thread((StgPtr)&w->finalizer);
555 if (w->link != NULL) {
556 thread((StgPtr)&w->link);
558 return p + sizeofW(StgWeak);
563 StgMVar *mvar = (StgMVar *)p;
564 thread((StgPtr)&mvar->head);
565 thread((StgPtr)&mvar->tail);
566 thread((StgPtr)&mvar->value);
567 return p + sizeofW(StgMVar);
571 case IND_OLDGEN_PERM:
572 thread((StgPtr)&((StgIndOldGen *)p)->indirectee);
573 return p + sizeofW(StgIndOldGen);
577 StgSelector *s = (StgSelector *)p;
578 thread((StgPtr)&s->selectee);
579 return p + THUNK_SELECTOR_sizeW();
583 return thread_AP_STACK((StgAP_STACK *)p);
587 return thread_PAP((StgPAP *)p);
590 return p + arr_words_sizeW((StgArrWords *)p);
593 case MUT_ARR_PTRS_FROZEN:
598 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
599 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
606 return thread_TSO((StgTSO *)p);
609 barf("update_fwd: unknown/strange object %d", (int)(info->type));
615 update_fwd( bdescr *blocks )
624 barf("update_fwd: ToDo");
627 // cycle through all the blocks in the step
628 for (; bd != NULL; bd = bd->link) {
631 // linearly scan the objects in this block
632 while (p < bd->free) {
633 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
634 info = get_itbl((StgClosure *)p);
635 p = thread_obj(info, p);
641 update_fwd_compact( bdescr *blocks )
647 bdescr *bd, *free_bd;
653 free = free_bd->start;
656 barf("update_fwd: ToDo");
659 // cycle through all the blocks in the step
660 for (; bd != NULL; bd = bd->link) {
663 while (p < bd->free ) {
665 while ( p < bd->free && !is_marked(p,bd) ) {
674 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
675 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
677 while ( p < bd->free ) {
682 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
690 // Problem: we need to know the destination for this cell
691 // in order to unthread its info pointer. But we can't
692 // know the destination without the size, because we may
693 // spill into the next block. So we have to run down the
694 // threaded list and get the info ptr first.
695 info = get_threaded_info(p);
699 p = thread_obj(info, p);
702 if (free + size > free_bd->start + BLOCK_SIZE_W) {
703 // unset the next bit in the bitmap to indicate that
704 // this object needs to be pushed into the next
705 // block. This saves us having to run down the
706 // threaded info pointer list twice during the next pass.
708 free_bd = free_bd->link;
709 free = free_bd->start;
711 ASSERT(is_marked(q+1,bd));
724 update_bkwd_compact( step *stp )
730 bdescr *bd, *free_bd;
732 nat size, free_blocks;
734 bd = free_bd = stp->blocks;
735 free = free_bd->start;
739 barf("update_bkwd: 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 if (!is_marked(p+1,bd)) {
774 // don't forget to update the free ptr in the block desc.
775 free_bd->free = free;
776 free_bd = free_bd->link;
777 free = free_bd->start;
782 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
783 info = get_itbl((StgClosure *)p);
784 size = obj_sizeW((StgClosure *)p,info);
790 // Rebuild the mutable list for the old generation.
791 if (ip_MUTABLE(info)) {
792 recordMutable((StgMutClosure *)free);
796 if (info->type == TSO) {
797 move_TSO((StgTSO *)p, (StgTSO *)free);
808 // free the remaining blocks and count what's left.
809 free_bd->free = free;
810 if (free_bd->link != NULL) {
811 freeChain(free_bd->link);
812 free_bd->link = NULL;
814 stp->n_blocks = free_blocks;
820 thread_mut_once_list( generation *g )
822 StgMutClosure *p, *next;
824 for (p = g->mut_once_list; p != END_MUT_LIST; p = next) {
826 thread((StgPtr)&p->mut_link);
829 thread((StgPtr)&g->mut_once_list);
833 compact( void (*get_roots)(evac_fn) )
838 // 1. thread the roots
839 get_roots((evac_fn)thread);
841 // the weak pointer lists...
842 if (weak_ptr_list != NULL) {
843 thread((StgPtr)&weak_ptr_list);
845 if (old_weak_ptr_list != NULL) {
846 thread((StgPtr)&old_weak_ptr_list); // tmp
850 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
851 thread((StgPtr)&generations[g].mut_list);
852 thread_mut_once_list(&generations[g]);
855 // the global thread list
856 thread((StgPtr)&all_threads);
858 // any threads resurrected during this GC
859 thread((StgPtr)&resurrected_threads);
861 // the main threads list
864 for (m = main_threads; m != NULL; m = m->link) {
865 thread((StgPtr)&m->tso);
869 // the static objects
870 thread_static(scavenged_static_objects);
872 // the stable pointer table
873 threadStablePtrTable((evac_fn)thread);
875 // the CAF list (used by GHCi)
876 markCAFs((evac_fn)thread);
878 // 2. update forward ptrs
879 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
880 for (s = 0; s < generations[g].n_steps; s++) {
881 stp = &generations[g].steps[s];
882 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d\n", stp->gen->no, stp->no););
884 update_fwd(stp->to_blocks);
885 update_fwd_large(stp->scavenged_large_objects);
886 if (g == RtsFlags.GcFlags.generations-1 && stp->blocks != NULL) {
887 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
888 update_fwd_compact(stp->blocks);
893 // 3. update backward ptrs
894 stp = &oldest_gen->steps[0];
895 if (stp->blocks != NULL) {
896 blocks = update_bkwd_compact(stp);
897 IF_DEBUG(gc, debugBelch("update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n",
898 stp->gen->no, stp->no,
899 stp->n_blocks, blocks););
900 stp->n_blocks = blocks;