1 /* -----------------------------------------------------------------------------
2 * $Id: GCCompact.c,v 1.18 2003/11/12 17:49:07 sof Exp $
4 * (c) The GHC Team 2001
6 * Compacting garbage collector
8 * ---------------------------------------------------------------------------*/
10 #include "PosixSource.h"
15 #include "BlockAlloc.h"
17 #include "GCCompact.h"
19 #include "StablePriv.h"
22 // Turn off inlining when debugging - it obfuscates things
25 # define STATIC_INLINE static
28 /* -----------------------------------------------------------------------------
29 Threading / unthreading pointers.
31 The basic idea here is to chain together all the fields pointing at
32 a particular object, with the root of the chain in the object's
33 info table field. The original contents of the info pointer goes
34 at the end of the chain.
36 Adding a new field to the chain is a matter of swapping the
37 contents of the field with the contents of the object's info table
40 To unthread the chain, we walk down it updating all the fields on
41 the chain with the new location of the object. We stop when we
42 reach the info pointer at the end.
44 We use a trick to identify the info pointer: when swapping pointers
45 for threading, we set the low bit of the original pointer, with the
46 result that all the pointers in the chain have their low bits set
47 except for the info pointer.
48 -------------------------------------------------------------------------- */
53 StgPtr q = (StgPtr)*p;
56 // It doesn't look like a closure at the moment, because the info
57 // ptr is possibly threaded:
58 // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
60 if (HEAP_ALLOCED(q)) {
62 // a handy way to discover whether the ptr is into the
63 // compacted area of the old gen, is that the EVACUATED flag
64 // is zero (it's non-zero for all the other areas of live
66 if ((bd->flags & BF_EVACUATED) == 0) {
68 *q = (StgWord)p + 1; // set the low bit
74 unthread( StgPtr p, StgPtr free )
76 StgPtr q = (StgPtr)*p, r;
78 while (((StgWord)q & 1) != 0) {
79 (StgWord)q -= 1; // unset the low bit again
87 STATIC_INLINE StgInfoTable *
88 get_threaded_info( StgPtr p )
90 StgPtr q = (P_)GET_INFO((StgClosure *)p);
92 while (((StgWord)q & 1) != 0) {
93 q = (P_)*((StgPtr)((StgWord)q-1));
96 ASSERT(LOOKS_LIKE_INFO_PTR(q));
97 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
100 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
101 // Remember, the two regions *might* overlap, but: to <= from.
103 move(StgPtr to, StgPtr from, nat size)
105 for(; size > 0; --size) {
111 obj_sizeW( StgClosure *p, StgInfoTable *info )
113 switch (info->type) {
118 return sizeofW(StgHeader) + 1;
130 return sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
132 return THUNK_SELECTOR_sizeW();
134 return ap_stack_sizeW((StgAP_STACK *)p);
137 return pap_sizeW((StgPAP *)p);
139 return arr_words_sizeW((StgArrWords *)p);
141 case MUT_ARR_PTRS_FROZEN:
142 return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
144 return tso_sizeW((StgTSO *)p);
146 return bco_sizeW((StgBCO *)p);
148 return sizeW_fromITBL(info);
153 thread_static( StgClosure* p )
155 const StgInfoTable *info;
157 // keep going until we've threaded all the objects on the linked
159 while (p != END_OF_STATIC_LIST) {
162 switch (info->type) {
165 thread((StgPtr)&((StgInd *)p)->indirectee);
166 p = IND_STATIC_LINK(p);
170 p = THUNK_STATIC_LINK(p);
173 p = FUN_STATIC_LINK(p);
176 p = STATIC_LINK(info,p);
180 barf("thread_static: strange closure %d", (int)(info->type));
187 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
193 bitmap = large_bitmap->bitmap[b];
194 for (i = 0; i < size; ) {
195 if ((bitmap & 1) == 0) {
200 if (i % BITS_IN(W_) == 0) {
202 bitmap = large_bitmap->bitmap[b];
204 bitmap = bitmap >> 1;
210 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
217 switch (fun_info->fun_type) {
219 bitmap = BITMAP_BITS(fun_info->bitmap);
220 size = BITMAP_SIZE(fun_info->bitmap);
223 size = ((StgLargeBitmap *)fun_info->bitmap)->size;
224 thread_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size);
228 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]);
229 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->fun_type]);
232 if ((bitmap & 1) == 0) {
236 bitmap = bitmap >> 1;
245 thread_stack(StgPtr p, StgPtr stack_end)
247 const StgRetInfoTable* info;
251 // highly similar to scavenge_stack, but we do pointer threading here.
253 while (p < stack_end) {
255 // *p must be the info pointer of an activation
256 // record. All activation records have 'bitmap' style layout
259 info = get_ret_itbl((StgClosure *)p);
261 switch (info->i.type) {
263 // Dynamic bitmap: the mask is stored on the stack
267 dyn = ((StgRetDyn *)p)->liveness;
269 // traverse the bitmap first
270 bitmap = GET_LIVENESS(dyn);
271 p = (P_)&((StgRetDyn *)p)->payload[0];
272 size = RET_DYN_BITMAP_SIZE;
274 if ((bitmap & 1) == 0) {
278 bitmap = bitmap >> 1;
282 // skip over the non-ptr words
283 p += GET_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
285 // follow the ptr words
286 for (size = GET_PTRS(dyn); size > 0; size--) {
293 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
299 bitmap = BITMAP_BITS(info->i.layout.bitmap);
300 size = BITMAP_SIZE(info->i.layout.bitmap);
302 // NOTE: the payload starts immediately after the info-ptr, we
303 // don't have an StgHeader in the same sense as a heap closure.
305 if ((bitmap & 1) == 0) {
309 bitmap = bitmap >> 1;
322 size = BCO_BITMAP_SIZE(bco);
323 thread_large_bitmap(p, BCO_BITMAP(bco), size);
328 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
332 size = info->i.layout.large_bitmap->size;
333 thread_large_bitmap(p, info->i.layout.large_bitmap, size);
339 StgRetFun *ret_fun = (StgRetFun *)p;
340 StgFunInfoTable *fun_info;
342 fun_info = itbl_to_fun_itbl(
343 get_threaded_info((StgPtr)ret_fun->fun));
344 // *before* threading it!
345 thread((StgPtr)&ret_fun->fun);
346 p = thread_arg_block(fun_info, ret_fun->payload);
351 barf("thread_stack: weird activation record found on stack: %d",
352 (int)(info->i.type));
358 thread_PAP (StgPAP *pap)
361 StgWord bitmap, size;
362 StgFunInfoTable *fun_info;
364 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)pap->fun));
365 ASSERT(fun_info->i.type != PAP);
367 p = (StgPtr)pap->payload;
370 switch (fun_info->fun_type) {
372 bitmap = BITMAP_BITS(fun_info->bitmap);
375 thread_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size);
379 thread_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun), size);
383 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]);
387 if ((bitmap & 1) == 0) {
391 bitmap = bitmap >> 1;
397 thread((StgPtr)&pap->fun);
402 thread_AP_STACK (StgAP_STACK *ap)
404 thread((StgPtr)&ap->fun);
405 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
406 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
410 thread_TSO (StgTSO *tso)
412 thread((StgPtr)&tso->link);
413 thread((StgPtr)&tso->global_link);
415 if ( tso->why_blocked == BlockedOnMVar
416 || tso->why_blocked == BlockedOnBlackHole
417 || tso->why_blocked == BlockedOnException
419 || tso->why_blocked == BlockedOnGA
420 || tso->why_blocked == BlockedOnGA_NoSend
423 thread((StgPtr)&tso->block_info.closure);
425 if ( tso->blocked_exceptions != NULL ) {
426 thread((StgPtr)&tso->blocked_exceptions);
429 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
430 return (StgPtr)tso + tso_sizeW(tso);
435 update_fwd_large( bdescr *bd )
438 const StgInfoTable* info;
440 for (; bd != NULL; bd = bd->link) {
443 info = get_itbl((StgClosure *)p);
445 switch (info->type) {
452 case MUT_ARR_PTRS_FROZEN:
457 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
458 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
465 thread_TSO((StgTSO *)p);
469 thread_AP_STACK((StgAP_STACK *)p);
473 thread_PAP((StgPAP *)p);
477 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
483 thread_obj (StgInfoTable *info, StgPtr p)
485 switch (info->type) {
488 return p + sizeofW(StgHeader) + 1;
492 thread((StgPtr)&((StgClosure *)p)->payload[0]);
493 return p + sizeofW(StgHeader) + 1;
496 thread((StgPtr)&((StgClosure *)p)->payload[0]);
497 return p + sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
499 case THUNK_0_1: // MIN_UPD_SIZE
503 return p + sizeofW(StgHeader) + 2;
508 thread((StgPtr)&((StgClosure *)p)->payload[0]);
509 return p + sizeofW(StgHeader) + 2;
514 thread((StgPtr)&((StgClosure *)p)->payload[0]);
515 thread((StgPtr)&((StgClosure *)p)->payload[1]);
516 return p + sizeofW(StgHeader) + 2;
519 StgBCO *bco = (StgBCO *)p;
520 thread((StgPtr)&bco->instrs);
521 thread((StgPtr)&bco->literals);
522 thread((StgPtr)&bco->ptrs);
523 thread((StgPtr)&bco->itbls);
524 return p + bco_sizeW(bco);
536 case SE_CAF_BLACKHOLE:
543 end = (P_)((StgClosure *)p)->payload +
544 info->layout.payload.ptrs;
545 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
548 return p + info->layout.payload.nptrs;
553 StgWeak *w = (StgWeak *)p;
554 thread((StgPtr)&w->key);
555 thread((StgPtr)&w->value);
556 thread((StgPtr)&w->finalizer);
557 if (w->link != NULL) {
558 thread((StgPtr)&w->link);
560 return p + sizeofW(StgWeak);
565 StgMVar *mvar = (StgMVar *)p;
566 thread((StgPtr)&mvar->head);
567 thread((StgPtr)&mvar->tail);
568 thread((StgPtr)&mvar->value);
569 return p + sizeofW(StgMVar);
573 case IND_OLDGEN_PERM:
574 thread((StgPtr)&((StgIndOldGen *)p)->indirectee);
575 return p + sizeofW(StgIndOldGen);
579 StgSelector *s = (StgSelector *)p;
580 thread((StgPtr)&s->selectee);
581 return p + THUNK_SELECTOR_sizeW();
585 return thread_AP_STACK((StgAP_STACK *)p);
589 return thread_PAP((StgPAP *)p);
592 return p + arr_words_sizeW((StgArrWords *)p);
595 case MUT_ARR_PTRS_FROZEN:
600 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
601 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
608 return thread_TSO((StgTSO *)p);
611 barf("update_fwd: unknown/strange object %d", (int)(info->type));
617 update_fwd( bdescr *blocks )
626 barf("update_fwd: ToDo");
629 // cycle through all the blocks in the step
630 for (; bd != NULL; bd = bd->link) {
633 // linearly scan the objects in this block
634 while (p < bd->free) {
635 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
636 info = get_itbl((StgClosure *)p);
637 p = thread_obj(info, p);
643 update_fwd_compact( bdescr *blocks )
649 bdescr *bd, *free_bd;
655 free = free_bd->start;
658 barf("update_fwd: ToDo");
661 // cycle through all the blocks in the step
662 for (; bd != NULL; bd = bd->link) {
665 while (p < bd->free ) {
667 while ( p < bd->free && !is_marked(p,bd) ) {
676 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
677 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
679 while ( p < bd->free ) {
684 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
692 // Problem: we need to know the destination for this cell
693 // in order to unthread its info pointer. But we can't
694 // know the destination without the size, because we may
695 // spill into the next block. So we have to run down the
696 // threaded list and get the info ptr first.
697 info = get_threaded_info(p);
701 p = thread_obj(info, p);
704 if (free + size > free_bd->start + BLOCK_SIZE_W) {
705 // unset the next bit in the bitmap to indicate that
706 // this object needs to be pushed into the next
707 // block. This saves us having to run down the
708 // threaded info pointer list twice during the next pass.
710 free_bd = free_bd->link;
711 free = free_bd->start;
713 ASSERT(is_marked(q+1,bd));
726 update_bkwd_compact( step *stp )
732 bdescr *bd, *free_bd;
734 nat size, free_blocks;
736 bd = free_bd = stp->blocks;
737 free = free_bd->start;
741 barf("update_bkwd: ToDo");
744 // cycle through all the blocks in the step
745 for (; bd != NULL; bd = bd->link) {
748 while (p < bd->free ) {
750 while ( p < bd->free && !is_marked(p,bd) ) {
759 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
760 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
762 while ( p < bd->free ) {
767 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
775 if (!is_marked(p+1,bd)) {
776 // don't forget to update the free ptr in the block desc.
777 free_bd->free = free;
778 free_bd = free_bd->link;
779 free = free_bd->start;
784 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
785 info = get_itbl((StgClosure *)p);
786 size = obj_sizeW((StgClosure *)p,info);
792 // Rebuild the mutable list for the old generation.
793 if (ip_MUTABLE(info)) {
794 recordMutable((StgMutClosure *)free);
798 if (info->type == TSO) {
799 move_TSO((StgTSO *)p, (StgTSO *)free);
810 // free the remaining blocks and count what's left.
811 free_bd->free = free;
812 if (free_bd->link != NULL) {
813 freeChain(free_bd->link);
814 free_bd->link = NULL;
816 stp->n_blocks = free_blocks;
822 thread_mut_once_list( generation *g )
824 StgMutClosure *p, *next;
826 for (p = g->mut_once_list; p != END_MUT_LIST; p = next) {
828 thread((StgPtr)&p->mut_link);
831 thread((StgPtr)&g->mut_once_list);
835 compact( void (*get_roots)(evac_fn) )
840 // 1. thread the roots
841 get_roots((evac_fn)thread);
843 // the weak pointer lists...
844 if (weak_ptr_list != NULL) {
845 thread((StgPtr)&weak_ptr_list);
847 if (old_weak_ptr_list != NULL) {
848 thread((StgPtr)&old_weak_ptr_list); // tmp
852 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
853 thread((StgPtr)&generations[g].mut_list);
854 thread_mut_once_list(&generations[g]);
857 // the global thread list
858 thread((StgPtr)&all_threads);
860 // any threads resurrected during this GC
861 thread((StgPtr)&resurrected_threads);
863 // the main threads list
866 for (m = main_threads; m != NULL; m = m->link) {
867 thread((StgPtr)&m->tso);
871 // the static objects
872 thread_static(scavenged_static_objects);
874 // the stable pointer table
875 threadStablePtrTable((evac_fn)thread);
877 // the CAF list (used by GHCi)
878 markCAFs((evac_fn)thread);
880 // 2. update forward ptrs
881 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
882 for (s = 0; s < generations[g].n_steps; s++) {
883 stp = &generations[g].steps[s];
884 IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d\n", stp->gen->no, stp->no););
886 update_fwd(stp->to_blocks);
887 update_fwd_large(stp->scavenged_large_objects);
888 if (g == RtsFlags.GcFlags.generations-1 && stp->blocks != NULL) {
889 IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
890 update_fwd_compact(stp->blocks);
895 // 3. update backward ptrs
896 stp = &oldest_gen->steps[0];
897 if (stp->blocks != NULL) {
898 blocks = update_bkwd_compact(stp);
899 IF_DEBUG(gc, fprintf(stderr,"update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n",
900 stp->gen->no, stp->no,
901 stp->n_blocks, blocks););
902 stp->n_blocks = blocks;