1 /* -----------------------------------------------------------------------------
2 * $Id: GCCompact.c,v 1.16 2003/04/22 16:25:10 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"
19 #include "StablePriv.h"
22 // Turn off inlining when debugging - it obfuscates things
29 /* -----------------------------------------------------------------------------
30 Threading / unthreading pointers.
32 The basic idea here is to chain together all the fields pointing at
33 a particular object, with the root of the chain in the object's
34 info table field. The original contents of the info pointer goes
35 at the end of the chain.
37 Adding a new field to the chain is a matter of swapping the
38 contents of the field with the contents of the object's info table
41 To unthread the chain, we walk down it updating all the fields on
42 the chain with the new location of the object. We stop when we
43 reach the info pointer at the end.
45 We use a trick to identify the info pointer: when swapping pointers
46 for threading, we set the low bit of the original pointer, with the
47 result that all the pointers in the chain have their low bits set
48 except for the info pointer.
49 -------------------------------------------------------------------------- */
54 StgPtr q = (StgPtr)*p;
57 // It doesn't look like a closure at the moment, because the info
58 // ptr is possibly threaded:
59 // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
61 if (HEAP_ALLOCED(q)) {
63 // a handy way to discover whether the ptr is into the
64 // compacted area of the old gen, is that the EVACUATED flag
65 // is zero (it's non-zero for all the other areas of live
67 if ((bd->flags & BF_EVACUATED) == 0) {
69 *q = (StgWord)p + 1; // set the low bit
75 unthread( StgPtr p, StgPtr free )
77 StgPtr q = (StgPtr)*p, r;
79 while (((StgWord)q & 1) != 0) {
80 (StgWord)q -= 1; // unset the low bit again
88 static INLINE StgInfoTable *
89 get_threaded_info( StgPtr p )
91 StgPtr q = (P_)GET_INFO((StgClosure *)p);
93 while (((StgWord)q & 1) != 0) {
94 q = (P_)*((StgPtr)((StgWord)q-1));
97 ASSERT(LOOKS_LIKE_INFO_PTR(q));
98 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
101 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
102 // Remember, the two regions *might* overlap, but: to <= from.
104 move(StgPtr to, StgPtr from, nat size)
106 for(; size > 0; --size) {
112 obj_sizeW( StgClosure *p, StgInfoTable *info )
114 switch (info->type) {
119 return sizeofW(StgHeader) + 1;
131 return sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
133 return THUNK_SELECTOR_sizeW();
135 return ap_stack_sizeW((StgAP_STACK *)p);
138 return pap_sizeW((StgPAP *)p);
140 return arr_words_sizeW((StgArrWords *)p);
142 case MUT_ARR_PTRS_FROZEN:
143 return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
145 return tso_sizeW((StgTSO *)p);
147 return bco_sizeW((StgBCO *)p);
149 return sizeW_fromITBL(info);
154 thread_static( StgClosure* p )
156 const StgInfoTable *info;
158 // keep going until we've threaded all the objects on the linked
160 while (p != END_OF_STATIC_LIST) {
163 switch (info->type) {
166 thread((StgPtr)&((StgInd *)p)->indirectee);
167 p = IND_STATIC_LINK(p);
171 p = THUNK_STATIC_LINK(p);
174 p = FUN_STATIC_LINK(p);
177 p = STATIC_LINK(info,p);
181 barf("thread_static: strange closure %d", (int)(info->type));
188 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
194 bitmap = large_bitmap->bitmap[b];
195 for (i = 0; i < size; ) {
196 if ((bitmap & 1) == 0) {
201 if (i % BITS_IN(W_) == 0) {
203 bitmap = large_bitmap->bitmap[b];
205 bitmap = bitmap >> 1;
211 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
218 switch (fun_info->fun_type) {
220 bitmap = BITMAP_BITS(fun_info->bitmap);
221 size = BITMAP_SIZE(fun_info->bitmap);
224 size = ((StgLargeBitmap *)fun_info->bitmap)->size;
225 thread_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size);
229 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]);
230 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->fun_type]);
233 if ((bitmap & 1) == 0) {
237 bitmap = bitmap >> 1;
246 thread_stack(StgPtr p, StgPtr stack_end)
248 const StgRetInfoTable* info;
252 // highly similar to scavenge_stack, but we do pointer threading here.
254 while (p < stack_end) {
256 // *p must be the info pointer of an activation
257 // record. All activation records have 'bitmap' style layout
260 info = get_ret_itbl((StgClosure *)p);
262 switch (info->i.type) {
264 // Dynamic bitmap: the mask is stored on the stack
268 dyn = ((StgRetDyn *)p)->liveness;
270 // traverse the bitmap first
271 bitmap = GET_LIVENESS(dyn);
272 p = (P_)&((StgRetDyn *)p)->payload[0];
273 size = RET_DYN_BITMAP_SIZE;
275 if ((bitmap & 1) == 0) {
279 bitmap = bitmap >> 1;
283 // skip over the non-ptr words
284 p += GET_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
286 // follow the ptr words
287 for (size = GET_PTRS(dyn); size > 0; size--) {
294 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
300 bitmap = BITMAP_BITS(info->i.layout.bitmap);
301 size = BITMAP_SIZE(info->i.layout.bitmap);
303 // NOTE: the payload starts immediately after the info-ptr, we
304 // don't have an StgHeader in the same sense as a heap closure.
306 if ((bitmap & 1) == 0) {
310 bitmap = bitmap >> 1;
323 size = BCO_BITMAP_SIZE(bco);
324 thread_large_bitmap(p, BCO_BITMAP(bco), size);
329 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
333 size = info->i.layout.large_bitmap->size;
334 thread_large_bitmap(p, info->i.layout.large_bitmap, size);
340 StgRetFun *ret_fun = (StgRetFun *)p;
341 StgFunInfoTable *fun_info;
343 fun_info = itbl_to_fun_itbl(
344 get_threaded_info((StgPtr)ret_fun->fun));
345 // *before* threading it!
346 thread((StgPtr)&ret_fun->fun);
347 p = thread_arg_block(fun_info, ret_fun->payload);
352 barf("thread_stack: weird activation record found on stack: %d",
353 (int)(info->i.type));
359 thread_PAP (StgPAP *pap)
362 StgWord bitmap, size;
363 StgFunInfoTable *fun_info;
365 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)pap->fun));
366 ASSERT(fun_info->i.type != PAP);
368 p = (StgPtr)pap->payload;
371 switch (fun_info->fun_type) {
373 bitmap = BITMAP_BITS(fun_info->bitmap);
376 thread_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size);
380 thread_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun), size);
384 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]);
388 if ((bitmap & 1) == 0) {
392 bitmap = bitmap >> 1;
398 thread((StgPtr)&pap->fun);
403 thread_AP_STACK (StgAP_STACK *ap)
405 thread((StgPtr)&ap->fun);
406 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
407 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
411 thread_TSO (StgTSO *tso)
413 thread((StgPtr)&tso->link);
414 thread((StgPtr)&tso->global_link);
416 if ( tso->why_blocked == BlockedOnMVar
417 || tso->why_blocked == BlockedOnBlackHole
418 || tso->why_blocked == BlockedOnException
420 || tso->why_blocked == BlockedOnGA
421 || tso->why_blocked == BlockedOnGA_NoSend
424 thread((StgPtr)&tso->block_info.closure);
426 if ( tso->blocked_exceptions != NULL ) {
427 thread((StgPtr)&tso->blocked_exceptions);
430 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
431 return (StgPtr)tso + tso_sizeW(tso);
436 update_fwd_large( bdescr *bd )
439 const StgInfoTable* info;
441 for (; bd != NULL; bd = bd->link) {
444 info = get_itbl((StgClosure *)p);
446 switch (info->type) {
453 case MUT_ARR_PTRS_FROZEN:
458 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
459 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
466 thread_TSO((StgTSO *)p);
470 thread_AP_STACK((StgAP_STACK *)p);
474 thread_PAP((StgPAP *)p);
478 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
484 thread_obj (StgInfoTable *info, StgPtr p)
486 switch (info->type) {
489 return p + sizeofW(StgHeader) + 1;
493 thread((StgPtr)&((StgClosure *)p)->payload[0]);
494 return p + sizeofW(StgHeader) + 1;
497 thread((StgPtr)&((StgClosure *)p)->payload[0]);
498 return p + sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
500 case THUNK_0_1: // MIN_UPD_SIZE
504 return p + sizeofW(StgHeader) + 2;
509 thread((StgPtr)&((StgClosure *)p)->payload[0]);
510 return p + sizeofW(StgHeader) + 2;
515 thread((StgPtr)&((StgClosure *)p)->payload[0]);
516 thread((StgPtr)&((StgClosure *)p)->payload[1]);
517 return p + sizeofW(StgHeader) + 2;
520 StgBCO *bco = (StgBCO *)p;
521 thread((StgPtr)&bco->instrs);
522 thread((StgPtr)&bco->literals);
523 thread((StgPtr)&bco->ptrs);
524 thread((StgPtr)&bco->itbls);
525 return p + bco_sizeW(bco);
537 case SE_CAF_BLACKHOLE:
544 end = (P_)((StgClosure *)p)->payload +
545 info->layout.payload.ptrs;
546 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
549 return p + info->layout.payload.nptrs;
554 StgWeak *w = (StgWeak *)p;
555 thread((StgPtr)&w->key);
556 thread((StgPtr)&w->value);
557 thread((StgPtr)&w->finalizer);
558 if (w->link != NULL) {
559 thread((StgPtr)&w->link);
561 return p + sizeofW(StgWeak);
566 StgMVar *mvar = (StgMVar *)p;
567 thread((StgPtr)&mvar->head);
568 thread((StgPtr)&mvar->tail);
569 thread((StgPtr)&mvar->value);
570 return p + sizeofW(StgMVar);
574 case IND_OLDGEN_PERM:
575 thread((StgPtr)&((StgIndOldGen *)p)->indirectee);
576 return p + sizeofW(StgIndOldGen);
580 StgSelector *s = (StgSelector *)p;
581 thread((StgPtr)&s->selectee);
582 return p + THUNK_SELECTOR_sizeW();
586 return thread_AP_STACK((StgAP_STACK *)p);
590 return thread_PAP((StgPAP *)p);
593 return p + arr_words_sizeW((StgArrWords *)p);
596 case MUT_ARR_PTRS_FROZEN:
601 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
602 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
609 return thread_TSO((StgTSO *)p);
612 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;