1 /* -----------------------------------------------------------------------------
2 * $Id: GCCompact.c,v 1.13 2002/12/11 15:36:42 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 /* -----------------------------------------------------------------------------
23 Threading / unthreading pointers.
25 The basic idea here is to chain together all the fields pointing at
26 a particular object, with the root of the chain in the object's
27 info table field. The original contents of the info pointer goes
28 at the end of the chain.
30 Adding a new field to the chain is a matter of swapping the
31 contents of the field with the contents of the object's info table
34 To unthread the chain, we walk down it updating all the fields on
35 the chain with the new location of the object. We stop when we
36 reach the info pointer at the end.
38 We use a trick to identify the info pointer: when swapping pointers
39 for threading, we set the low bit of the original pointer, with the
40 result that all the pointers in the chain have their low bits set
41 except for the info pointer.
42 -------------------------------------------------------------------------- */
47 StgPtr q = (StgPtr)*p;
50 // It doesn't look like a closure at the moment, because the info
51 // ptr is possibly threaded:
52 // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
54 if (HEAP_ALLOCED(q)) {
56 // a handy way to discover whether the ptr is into the
57 // compacted area of the old gen, is that the EVACUATED flag
58 // is zero (it's non-zero for all the other areas of live
60 if ((bd->flags & BF_EVACUATED) == 0) {
62 *q = (StgWord)p + 1; // set the low bit
68 unthread( StgPtr p, StgPtr free )
70 StgPtr q = (StgPtr)*p, r;
72 while (((StgWord)q & 1) != 0) {
73 (StgWord)q -= 1; // unset the low bit again
81 static inline StgInfoTable *
82 get_threaded_info( StgPtr p )
84 StgPtr q = (P_)GET_INFO((StgClosure *)p);
86 while (((StgWord)q & 1) != 0) {
87 q = (P_)*((StgPtr)((StgWord)q-1));
90 ASSERT(LOOKS_LIKE_INFO_PTR(q));
91 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
94 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
95 // Remember, the two regions *might* overlap, but: to <= from.
97 move(StgPtr to, StgPtr from, nat size)
99 for(; size > 0; --size) {
105 obj_sizeW( StgClosure *p, StgInfoTable *info )
107 switch (info->type) {
112 return sizeofW(StgHeader) + 1;
124 return sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
126 return THUNK_SELECTOR_sizeW();
128 return ap_stack_sizeW((StgAP_STACK *)p);
131 return pap_sizeW((StgPAP *)p);
133 return arr_words_sizeW((StgArrWords *)p);
135 case MUT_ARR_PTRS_FROZEN:
136 return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
138 return tso_sizeW((StgTSO *)p);
140 return sizeW_fromITBL(info);
145 thread_static( StgClosure* p )
147 const StgInfoTable *info;
149 // keep going until we've threaded all the objects on the linked
151 while (p != END_OF_STATIC_LIST) {
154 switch (info->type) {
157 thread((StgPtr)&((StgInd *)p)->indirectee);
158 p = IND_STATIC_LINK(p);
162 p = THUNK_STATIC_LINK(p);
165 p = FUN_STATIC_LINK(p);
168 p = STATIC_LINK(info,p);
172 barf("thread_static: strange closure %d", (int)(info->type));
179 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
185 bitmap = large_bitmap->bitmap[b];
186 for (i = 0; i < size; ) {
187 if ((bitmap & 1) == 0) {
192 if (i % BITS_IN(W_) == 0) {
194 bitmap = large_bitmap->bitmap[b];
196 bitmap = bitmap >> 1;
202 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
209 switch (fun_info->fun_type) {
211 bitmap = BITMAP_BITS(fun_info->bitmap);
212 size = BITMAP_SIZE(fun_info->bitmap);
215 size = ((StgLargeBitmap *)fun_info->bitmap)->size;
216 thread_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size);
220 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]);
221 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->fun_type]);
224 if ((bitmap & 1) == 0) {
228 bitmap = bitmap >> 1;
237 thread_stack(StgPtr p, StgPtr stack_end)
239 const StgRetInfoTable* info;
243 // highly similar to scavenge_stack, but we do pointer threading here.
245 while (p < stack_end) {
247 // *p must be the info pointer of an activation
248 // record. All activation records have 'bitmap' style layout
251 info = get_ret_itbl((StgClosure *)p);
253 switch (info->i.type) {
255 // Dynamic bitmap: the mask is stored on the stack
259 dyn = ((StgRetDyn *)p)->liveness;
261 // traverse the bitmap first
262 bitmap = GET_LIVENESS(dyn);
263 p = (P_)&((StgRetDyn *)p)->payload[0];
266 if ((bitmap & 1) == 0) {
270 bitmap = bitmap >> 1;
274 // skip over the non-ptr words
275 p += GET_NONPTRS(dyn);
277 // follow the ptr words
278 for (size = GET_PTRS(dyn); size > 0; size--) {
285 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
291 bitmap = BITMAP_BITS(info->i.layout.bitmap);
292 size = BITMAP_SIZE(info->i.layout.bitmap);
294 // NOTE: the payload starts immediately after the info-ptr, we
295 // don't have an StgHeader in the same sense as a heap closure.
297 if ((bitmap & 1) == 0) {
301 bitmap = bitmap >> 1;
314 size = BCO_BITMAP_SIZE(bco);
315 thread_large_bitmap(p, BCO_BITMAP(bco), size);
320 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
324 size = info->i.layout.large_bitmap->size;
325 thread_large_bitmap(p, info->i.layout.large_bitmap, size);
331 StgRetFun *ret_fun = (StgRetFun *)p;
332 StgFunInfoTable *fun_info;
334 fun_info = get_fun_itbl(ret_fun->fun); // *before* threading it!
335 thread((StgPtr)&ret_fun->fun);
336 p = thread_arg_block(fun_info, ret_fun->payload);
341 barf("thread_stack: weird activation record found on stack: %d",
342 (int)(info->i.type));
348 thread_PAP (StgPAP *pap)
351 StgWord bitmap, size;
352 StgFunInfoTable *fun_info;
354 thread((StgPtr)&pap->fun);
355 fun_info = get_fun_itbl(pap->fun);
356 ASSERT(fun_info->i.type != PAP);
358 p = (StgPtr)pap->payload;
361 switch (fun_info->fun_type) {
363 bitmap = BITMAP_BITS(fun_info->bitmap);
366 thread_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size);
370 thread_large_bitmap((StgPtr)pap->payload, BCO_BITMAP(pap->fun), size);
374 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]);
378 if ((bitmap & 1) == 0) {
382 bitmap = bitmap >> 1;
391 thread_AP_STACK (StgAP_STACK *ap)
393 thread((StgPtr)&ap->fun);
394 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
395 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
399 thread_TSO (StgTSO *tso)
401 thread((StgPtr)&tso->link);
402 thread((StgPtr)&tso->global_link);
404 if ( tso->why_blocked == BlockedOnMVar
405 || tso->why_blocked == BlockedOnBlackHole
406 || tso->why_blocked == BlockedOnException
408 || tso->why_blocked == BlockedOnGA
409 || tso->why_blocked == BlockedOnGA_NoSend
412 thread((StgPtr)&tso->block_info.closure);
414 if ( tso->blocked_exceptions != NULL ) {
415 thread((StgPtr)&tso->blocked_exceptions);
418 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
419 return (StgPtr)tso + tso_sizeW(tso);
424 update_fwd_large( bdescr *bd )
427 const StgInfoTable* info;
429 for (; bd != NULL; bd = bd->link) {
432 info = get_itbl((StgClosure *)p);
434 switch (info->type) {
441 case MUT_ARR_PTRS_FROZEN:
446 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
447 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
454 thread_TSO((StgTSO *)p);
458 thread_AP_STACK((StgAP_STACK *)p);
462 thread_PAP((StgPAP *)p);
466 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
472 thread_obj (StgInfoTable *info, StgPtr p)
474 switch (info->type) {
477 return p + sizeofW(StgHeader) + 1;
481 thread((StgPtr)&((StgClosure *)p)->payload[0]);
482 return p + sizeofW(StgHeader) + 1;
485 thread((StgPtr)&((StgClosure *)p)->payload[0]);
486 return p + sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
488 case THUNK_0_1: // MIN_UPD_SIZE
492 return p + sizeofW(StgHeader) + 2;
497 thread((StgPtr)&((StgClosure *)p)->payload[0]);
498 return p + sizeofW(StgHeader) + 2;
503 thread((StgPtr)&((StgClosure *)p)->payload[0]);
504 thread((StgPtr)&((StgClosure *)p)->payload[1]);
505 return p + sizeofW(StgHeader) + 2;
517 case SE_CAF_BLACKHOLE:
524 end = (P_)((StgClosure *)p)->payload +
525 info->layout.payload.ptrs;
526 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
529 return p + info->layout.payload.nptrs;
534 StgWeak *w = (StgWeak *)p;
535 thread((StgPtr)&w->key);
536 thread((StgPtr)&w->value);
537 thread((StgPtr)&w->finalizer);
538 if (w->link != NULL) {
539 thread((StgPtr)&w->link);
541 return p + sizeofW(StgWeak);
546 StgMVar *mvar = (StgMVar *)p;
547 thread((StgPtr)&mvar->head);
548 thread((StgPtr)&mvar->tail);
549 thread((StgPtr)&mvar->value);
550 return p + sizeofW(StgMVar);
554 case IND_OLDGEN_PERM:
555 thread((StgPtr)&((StgIndOldGen *)p)->indirectee);
556 return p + sizeofW(StgIndOldGen);
560 StgSelector *s = (StgSelector *)p;
561 thread((StgPtr)&s->selectee);
562 return p + THUNK_SELECTOR_sizeW();
566 return thread_AP_STACK((StgAP_STACK *)p);
570 return thread_PAP((StgPAP *)p);
573 return p + arr_words_sizeW((StgArrWords *)p);
576 case MUT_ARR_PTRS_FROZEN:
581 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
582 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
589 return thread_TSO((StgTSO *)p);
592 barf("update_fwd: unknown/strange object %d", (int)(info->type));
597 update_fwd( bdescr *blocks )
606 barf("update_fwd: ToDo");
609 // cycle through all the blocks in the step
610 for (; bd != NULL; bd = bd->link) {
613 // linearly scan the objects in this block
614 while (p < bd->free) {
615 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
616 info = get_itbl((StgClosure *)p);
617 p = thread_obj(info, p);
623 update_fwd_compact( bdescr *blocks )
629 bdescr *bd, *free_bd;
635 free = free_bd->start;
638 barf("update_fwd: ToDo");
641 // cycle through all the blocks in the step
642 for (; bd != NULL; bd = bd->link) {
645 while (p < bd->free ) {
647 while ( p < bd->free && !is_marked(p,bd) ) {
656 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
657 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
659 while ( p < bd->free ) {
664 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
672 // Problem: we need to know the destination for this cell
673 // in order to unthread its info pointer. But we can't
674 // know the destination without the size, because we may
675 // spill into the next block. So we have to run down the
676 // threaded list and get the info ptr first.
677 info = get_threaded_info(p);
681 p = thread_obj(info, p);
684 if (free + size > free_bd->start + BLOCK_SIZE_W) {
685 // unset the next bit in the bitmap to indicate that
686 // this object needs to be pushed into the next
687 // block. This saves us having to run down the
688 // threaded info pointer list twice during the next pass.
690 free_bd = free_bd->link;
691 free = free_bd->start;
693 ASSERT(is_marked(q+1,bd));
706 update_bkwd_compact( step *stp )
712 bdescr *bd, *free_bd;
714 nat size, free_blocks;
716 bd = free_bd = stp->blocks;
717 free = free_bd->start;
721 barf("update_bkwd: ToDo");
724 // cycle through all the blocks in the step
725 for (; bd != NULL; bd = bd->link) {
728 while (p < bd->free ) {
730 while ( p < bd->free && !is_marked(p,bd) ) {
739 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
740 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
742 while ( p < bd->free ) {
747 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
755 if (!is_marked(p+1,bd)) {
756 // don't forget to update the free ptr in the block desc.
757 free_bd->free = free;
758 free_bd = free_bd->link;
759 free = free_bd->start;
764 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
765 info = get_itbl((StgClosure *)p);
766 size = obj_sizeW((StgClosure *)p,info);
772 // Rebuild the mutable list for the old generation.
773 if (ip_MUTABLE(info)) {
774 recordMutable((StgMutClosure *)free);
778 if (info->type == TSO) {
779 move_TSO((StgTSO *)p, (StgTSO *)free);
790 // free the remaining blocks and count what's left.
791 free_bd->free = free;
792 if (free_bd->link != NULL) {
793 freeChain(free_bd->link);
794 free_bd->link = NULL;
796 stp->n_blocks = free_blocks;
802 thread_mut_once_list( generation *g )
804 StgMutClosure *p, *next;
806 for (p = g->mut_once_list; p != END_MUT_LIST; p = next) {
808 thread((StgPtr)&p->mut_link);
811 thread((StgPtr)&g->mut_once_list);
815 compact( void (*get_roots)(evac_fn) )
820 // 1. thread the roots
821 get_roots((evac_fn)thread);
823 // the weak pointer lists...
824 if (weak_ptr_list != NULL) {
825 thread((StgPtr)&weak_ptr_list);
827 if (old_weak_ptr_list != NULL) {
828 thread((StgPtr)&old_weak_ptr_list); // tmp
832 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
833 thread((StgPtr)&generations[g].mut_list);
834 thread_mut_once_list(&generations[g]);
837 // the global thread list
838 thread((StgPtr)&all_threads);
840 // any threads resurrected during this GC
841 thread((StgPtr)&resurrected_threads);
843 // the main threads list
846 for (m = main_threads; m != NULL; m = m->link) {
847 thread((StgPtr)&m->tso);
851 // the static objects
852 thread_static(scavenged_static_objects);
854 // the stable pointer table
855 threadStablePtrTable((evac_fn)thread);
857 // the CAF list (used by GHCi)
858 markCAFs((evac_fn)thread);
860 // 2. update forward ptrs
861 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
862 for (s = 0; s < generations[g].n_steps; s++) {
863 stp = &generations[g].steps[s];
864 IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d\n", stp->gen->no, stp->no););
866 update_fwd(stp->to_blocks);
867 update_fwd_large(stp->scavenged_large_objects);
868 if (g == RtsFlags.GcFlags.generations-1 && stp->blocks != NULL) {
869 IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
870 update_fwd_compact(stp->blocks);
875 // 3. update backward ptrs
876 stp = &oldest_gen->steps[0];
877 if (stp->blocks != NULL) {
878 blocks = update_bkwd_compact(stp);
879 IF_DEBUG(gc, fprintf(stderr,"update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n",
880 stp->gen->no, stp->no,
881 stp->n_blocks, blocks););
882 stp->n_blocks = blocks;