1 /* -----------------------------------------------------------------------------
2 * $Id: GCCompact.c,v 1.19 2004/08/13 13:09:56 simonmar Exp $
4 * (c) The GHC Team 2001
6 * Compacting garbage collector
8 * ---------------------------------------------------------------------------*/
10 #include "PosixSource.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 )
75 StgPtr q = (StgPtr)*p, r;
77 while (((StgWord)q & 1) != 0) {
78 (StgWord)q -= 1; // unset the low bit again
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) {
117 return sizeofW(StgHeader) + 1;
129 return sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
131 return THUNK_SELECTOR_sizeW();
133 return ap_stack_sizeW((StgAP_STACK *)p);
136 return pap_sizeW((StgPAP *)p);
138 return arr_words_sizeW((StgArrWords *)p);
140 case MUT_ARR_PTRS_FROZEN:
141 return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
143 return tso_sizeW((StgTSO *)p);
145 return bco_sizeW((StgBCO *)p);
147 return sizeW_fromITBL(info);
152 thread_static( StgClosure* p )
154 const StgInfoTable *info;
156 // keep going until we've threaded all the objects on the linked
158 while (p != END_OF_STATIC_LIST) {
161 switch (info->type) {
164 thread((StgPtr)&((StgInd *)p)->indirectee);
165 p = IND_STATIC_LINK(p);
169 p = THUNK_STATIC_LINK(p);
172 p = FUN_STATIC_LINK(p);
175 p = STATIC_LINK(info,p);
179 barf("thread_static: strange closure %d", (int)(info->type));
186 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
192 bitmap = large_bitmap->bitmap[b];
193 for (i = 0; i < size; ) {
194 if ((bitmap & 1) == 0) {
199 if (i % BITS_IN(W_) == 0) {
201 bitmap = large_bitmap->bitmap[b];
203 bitmap = bitmap >> 1;
209 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
216 switch (fun_info->f.fun_type) {
218 bitmap = BITMAP_BITS(fun_info->f.bitmap);
219 size = BITMAP_SIZE(fun_info->f.bitmap);
222 size = ((StgLargeBitmap *)fun_info->f.bitmap)->size;
223 thread_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap, size);
227 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
228 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
231 if ((bitmap & 1) == 0) {
235 bitmap = bitmap >> 1;
244 thread_stack(StgPtr p, StgPtr stack_end)
246 const StgRetInfoTable* info;
250 // highly similar to scavenge_stack, but we do pointer threading here.
252 while (p < stack_end) {
254 // *p must be the info pointer of an activation
255 // record. All activation records have 'bitmap' style layout
258 info = get_ret_itbl((StgClosure *)p);
260 switch (info->i.type) {
262 // Dynamic bitmap: the mask is stored on the stack
266 dyn = ((StgRetDyn *)p)->liveness;
268 // traverse the bitmap first
269 bitmap = RET_DYN_LIVENESS(dyn);
270 p = (P_)&((StgRetDyn *)p)->payload[0];
271 size = RET_DYN_BITMAP_SIZE;
273 if ((bitmap & 1) == 0) {
277 bitmap = bitmap >> 1;
281 // skip over the non-ptr words
282 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
284 // follow the ptr words
285 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
292 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
298 bitmap = BITMAP_BITS(info->i.layout.bitmap);
299 size = BITMAP_SIZE(info->i.layout.bitmap);
301 // NOTE: the payload starts immediately after the info-ptr, we
302 // don't have an StgHeader in the same sense as a heap closure.
304 if ((bitmap & 1) == 0) {
308 bitmap = bitmap >> 1;
321 size = BCO_BITMAP_SIZE(bco);
322 thread_large_bitmap(p, BCO_BITMAP(bco), size);
327 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
331 size = info->i.layout.large_bitmap->size;
332 thread_large_bitmap(p, info->i.layout.large_bitmap, size);
338 StgRetFun *ret_fun = (StgRetFun *)p;
339 StgFunInfoTable *fun_info;
341 fun_info = itbl_to_fun_itbl(
342 get_threaded_info((StgPtr)ret_fun->fun));
343 // *before* threading it!
344 thread((StgPtr)&ret_fun->fun);
345 p = thread_arg_block(fun_info, ret_fun->payload);
350 barf("thread_stack: weird activation record found on stack: %d",
351 (int)(info->i.type));
357 thread_PAP (StgPAP *pap)
360 StgWord bitmap, size;
361 StgFunInfoTable *fun_info;
363 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)pap->fun));
364 ASSERT(fun_info->i.type != PAP);
366 p = (StgPtr)pap->payload;
369 switch (fun_info->f.fun_type) {
371 bitmap = BITMAP_BITS(fun_info->f.bitmap);
374 thread_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap, size);
378 thread_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun), size);
382 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
386 if ((bitmap & 1) == 0) {
390 bitmap = bitmap >> 1;
396 thread((StgPtr)&pap->fun);
401 thread_AP_STACK (StgAP_STACK *ap)
403 thread((StgPtr)&ap->fun);
404 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
405 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
409 thread_TSO (StgTSO *tso)
411 thread((StgPtr)&tso->link);
412 thread((StgPtr)&tso->global_link);
414 if ( tso->why_blocked == BlockedOnMVar
415 || tso->why_blocked == BlockedOnBlackHole
416 || tso->why_blocked == BlockedOnException
418 || tso->why_blocked == BlockedOnGA
419 || tso->why_blocked == BlockedOnGA_NoSend
422 thread((StgPtr)&tso->block_info.closure);
424 if ( tso->blocked_exceptions != NULL ) {
425 thread((StgPtr)&tso->blocked_exceptions);
428 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
429 return (StgPtr)tso + tso_sizeW(tso);
434 update_fwd_large( bdescr *bd )
437 const StgInfoTable* info;
439 for (; bd != NULL; bd = bd->link) {
442 info = get_itbl((StgClosure *)p);
444 switch (info->type) {
451 case MUT_ARR_PTRS_FROZEN:
456 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
457 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
464 thread_TSO((StgTSO *)p);
468 thread_AP_STACK((StgAP_STACK *)p);
472 thread_PAP((StgPAP *)p);
476 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
482 thread_obj (StgInfoTable *info, StgPtr p)
484 switch (info->type) {
487 return p + sizeofW(StgHeader) + 1;
491 thread((StgPtr)&((StgClosure *)p)->payload[0]);
492 return p + sizeofW(StgHeader) + 1;
495 thread((StgPtr)&((StgClosure *)p)->payload[0]);
496 return p + sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
498 case THUNK_0_1: // MIN_UPD_SIZE
502 return p + sizeofW(StgHeader) + 2;
507 thread((StgPtr)&((StgClosure *)p)->payload[0]);
508 return p + sizeofW(StgHeader) + 2;
513 thread((StgPtr)&((StgClosure *)p)->payload[0]);
514 thread((StgPtr)&((StgClosure *)p)->payload[1]);
515 return p + sizeofW(StgHeader) + 2;
518 StgBCO *bco = (StgBCO *)p;
519 thread((StgPtr)&bco->instrs);
520 thread((StgPtr)&bco->literals);
521 thread((StgPtr)&bco->ptrs);
522 thread((StgPtr)&bco->itbls);
523 return p + bco_sizeW(bco);
535 case SE_CAF_BLACKHOLE:
542 end = (P_)((StgClosure *)p)->payload +
543 info->layout.payload.ptrs;
544 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
547 return p + info->layout.payload.nptrs;
552 StgWeak *w = (StgWeak *)p;
553 thread((StgPtr)&w->key);
554 thread((StgPtr)&w->value);
555 thread((StgPtr)&w->finalizer);
556 if (w->link != NULL) {
557 thread((StgPtr)&w->link);
559 return p + sizeofW(StgWeak);
564 StgMVar *mvar = (StgMVar *)p;
565 thread((StgPtr)&mvar->head);
566 thread((StgPtr)&mvar->tail);
567 thread((StgPtr)&mvar->value);
568 return p + sizeofW(StgMVar);
572 case IND_OLDGEN_PERM:
573 thread((StgPtr)&((StgIndOldGen *)p)->indirectee);
574 return p + sizeofW(StgIndOldGen);
578 StgSelector *s = (StgSelector *)p;
579 thread((StgPtr)&s->selectee);
580 return p + THUNK_SELECTOR_sizeW();
584 return thread_AP_STACK((StgAP_STACK *)p);
588 return thread_PAP((StgPAP *)p);
591 return p + arr_words_sizeW((StgArrWords *)p);
594 case MUT_ARR_PTRS_FROZEN:
599 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
600 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
607 return thread_TSO((StgTSO *)p);
610 barf("update_fwd: unknown/strange object %d", (int)(info->type));
616 update_fwd( bdescr *blocks )
625 barf("update_fwd: ToDo");
628 // cycle through all the blocks in the step
629 for (; bd != NULL; bd = bd->link) {
632 // linearly scan the objects in this block
633 while (p < bd->free) {
634 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
635 info = get_itbl((StgClosure *)p);
636 p = thread_obj(info, p);
642 update_fwd_compact( bdescr *blocks )
648 bdescr *bd, *free_bd;
654 free = free_bd->start;
657 barf("update_fwd: ToDo");
660 // cycle through all the blocks in the step
661 for (; bd != NULL; bd = bd->link) {
664 while (p < bd->free ) {
666 while ( p < bd->free && !is_marked(p,bd) ) {
675 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
676 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
678 while ( p < bd->free ) {
683 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
691 // Problem: we need to know the destination for this cell
692 // in order to unthread its info pointer. But we can't
693 // know the destination without the size, because we may
694 // spill into the next block. So we have to run down the
695 // threaded list and get the info ptr first.
696 info = get_threaded_info(p);
700 p = thread_obj(info, p);
703 if (free + size > free_bd->start + BLOCK_SIZE_W) {
704 // unset the next bit in the bitmap to indicate that
705 // this object needs to be pushed into the next
706 // block. This saves us having to run down the
707 // threaded info pointer list twice during the next pass.
709 free_bd = free_bd->link;
710 free = free_bd->start;
712 ASSERT(is_marked(q+1,bd));
725 update_bkwd_compact( step *stp )
731 bdescr *bd, *free_bd;
733 nat size, free_blocks;
735 bd = free_bd = stp->blocks;
736 free = free_bd->start;
740 barf("update_bkwd: ToDo");
743 // cycle through all the blocks in the step
744 for (; bd != NULL; bd = bd->link) {
747 while (p < bd->free ) {
749 while ( p < bd->free && !is_marked(p,bd) ) {
758 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
759 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
761 while ( p < bd->free ) {
766 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
774 if (!is_marked(p+1,bd)) {
775 // don't forget to update the free ptr in the block desc.
776 free_bd->free = free;
777 free_bd = free_bd->link;
778 free = free_bd->start;
783 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
784 info = get_itbl((StgClosure *)p);
785 size = obj_sizeW((StgClosure *)p,info);
791 // Rebuild the mutable list for the old generation.
792 if (ip_MUTABLE(info)) {
793 recordMutable((StgMutClosure *)free);
797 if (info->type == TSO) {
798 move_TSO((StgTSO *)p, (StgTSO *)free);
809 // free the remaining blocks and count what's left.
810 free_bd->free = free;
811 if (free_bd->link != NULL) {
812 freeChain(free_bd->link);
813 free_bd->link = NULL;
815 stp->n_blocks = free_blocks;
821 thread_mut_once_list( generation *g )
823 StgMutClosure *p, *next;
825 for (p = g->mut_once_list; p != END_MUT_LIST; p = next) {
827 thread((StgPtr)&p->mut_link);
830 thread((StgPtr)&g->mut_once_list);
834 compact( void (*get_roots)(evac_fn) )
839 // 1. thread the roots
840 get_roots((evac_fn)thread);
842 // the weak pointer lists...
843 if (weak_ptr_list != NULL) {
844 thread((StgPtr)&weak_ptr_list);
846 if (old_weak_ptr_list != NULL) {
847 thread((StgPtr)&old_weak_ptr_list); // tmp
851 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
852 thread((StgPtr)&generations[g].mut_list);
853 thread_mut_once_list(&generations[g]);
856 // the global thread list
857 thread((StgPtr)&all_threads);
859 // any threads resurrected during this GC
860 thread((StgPtr)&resurrected_threads);
862 // the main threads list
865 for (m = main_threads; m != NULL; m = m->link) {
866 thread((StgPtr)&m->tso);
870 // the static objects
871 thread_static(scavenged_static_objects);
873 // the stable pointer table
874 threadStablePtrTable((evac_fn)thread);
876 // the CAF list (used by GHCi)
877 markCAFs((evac_fn)thread);
879 // 2. update forward ptrs
880 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
881 for (s = 0; s < generations[g].n_steps; s++) {
882 stp = &generations[g].steps[s];
883 IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d\n", stp->gen->no, stp->no););
885 update_fwd(stp->to_blocks);
886 update_fwd_large(stp->scavenged_large_objects);
887 if (g == RtsFlags.GcFlags.generations-1 && stp->blocks != NULL) {
888 IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
889 update_fwd_compact(stp->blocks);
894 // 3. update backward ptrs
895 stp = &oldest_gen->steps[0];
896 if (stp->blocks != NULL) {
897 blocks = update_bkwd_compact(stp);
898 IF_DEBUG(gc, fprintf(stderr,"update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n",
899 stp->gen->no, stp->no,
900 stp->n_blocks, blocks););
901 stp->n_blocks = blocks;