1 /* -----------------------------------------------------------------------------
2 * $Id: GCCompact.c,v 1.10 2001/10/19 09:41:11 sewardj 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"
21 /* -----------------------------------------------------------------------------
22 Threading / unthreading pointers.
24 The basic idea here is to chain together all the fields pointing at
25 a particular object, with the root of the chain in the object's
26 info table field. The original contents of the info pointer goes
27 at the end of the chain.
29 Adding a new field to the chain is a matter of swapping the
30 contents of the field with the contents of the object's info table
33 To unthread the chain, we walk down it updating all the fields on
34 the chain with the new location of the object. We stop when we
35 reach the info pointer at the end.
37 We use a trick to identify the info pointer, because the
38 LOOKS_LIKE_GHC_INFO() macro involves a function call and can be
39 expensive. The trick is that when swapping pointers for threading,
40 we set the low bit of the original pointer, with the result that
41 all the pointers in the chain have their low bits set except for
43 -------------------------------------------------------------------------- */
48 StgPtr q = (StgPtr)*p;
51 ASSERT(!LOOKS_LIKE_GHC_INFO(q));
52 if (HEAP_ALLOCED(q)) {
54 // a handy way to discover whether the ptr is into the
55 // compacted area of the old gen, is that the EVACUATED flag
56 // is zero (it's non-zero for all the other areas of live
58 if ((bd->flags & BF_EVACUATED) == 0) {
60 *q = (StgWord)p + 1; // set the low bit
66 unthread( StgPtr p, StgPtr free )
68 StgPtr q = (StgPtr)*p, r;
70 while (((StgWord)q & 1) != 0) {
71 (StgWord)q -= 1; // unset the low bit again
79 static inline StgInfoTable *
80 get_threaded_info( StgPtr p )
82 StgPtr q = (P_)GET_INFO((StgClosure *)p);
84 while (((StgWord)q & 1) != 0) {
85 q = (P_)*((StgPtr)((StgWord)q-1));
87 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
90 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
91 // Remember, the two regions *might* overlap, but: to <= from.
93 move(StgPtr to, StgPtr from, nat size)
95 for(; size > 0; --size) {
101 obj_sizeW( StgClosure *p, StgInfoTable *info )
103 switch (info->type) {
108 return sizeofW(StgHeader) + 1;
120 return sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
122 return THUNK_SELECTOR_sizeW();
125 return pap_sizeW((StgPAP *)p);
127 return arr_words_sizeW((StgArrWords *)p);
129 case MUT_ARR_PTRS_FROZEN:
130 return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
132 return tso_sizeW((StgTSO *)p);
134 return sizeW_fromITBL(info);
139 thread_static( StgClosure* p )
141 const StgInfoTable *info;
143 // keep going until we've threaded all the objects on the linked
145 while (p != END_OF_STATIC_LIST) {
148 switch (info->type) {
151 thread((StgPtr)&((StgInd *)p)->indirectee);
152 p = IND_STATIC_LINK(p);
156 p = THUNK_STATIC_LINK(p);
159 p = FUN_STATIC_LINK(p);
162 p = STATIC_LINK(info,p);
166 barf("thread_static: strange closure %d", (int)(info->type));
173 thread_stack(StgPtr p, StgPtr stack_end)
176 const StgInfoTable* info;
179 // highly similar to scavenge_stack, but we do pointer threading here.
181 while (p < stack_end) {
184 // If we've got a tag, skip over that many words on the stack
185 if ( IS_ARG_TAG((W_)q) ) {
190 // Is q a pointer to a closure?
191 if ( !LOOKS_LIKE_GHC_INFO(q) ) {
197 // Otherwise, q must be the info pointer of an activation
198 // record. All activation records have 'bitmap' style layout
201 info = get_itbl((StgClosure *)p);
203 switch (info->type) {
205 // Dynamic bitmap: the mask is stored on the stack
207 bitmap = ((StgRetDyn *)p)->liveness;
208 p = (P_)&((StgRetDyn *)p)->payload[0];
211 // probably a slow-entry point return address:
217 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
225 bitmap = info->layout.bitmap;
227 // this assumes that the payload starts immediately after the info-ptr
229 while (bitmap != 0) {
230 if ((bitmap & 1) == 0) {
234 bitmap = bitmap >> 1;
238 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
243 StgLargeBitmap *large_bitmap;
246 large_bitmap = info->layout.large_bitmap;
249 for (i=0; i<large_bitmap->size; i++) {
250 bitmap = large_bitmap->bitmap[i];
252 while (bitmap != 0) {
253 if ((bitmap & 1) == 0) {
257 bitmap = bitmap >> 1;
259 if (i+1 < large_bitmap->size) {
270 barf("thread_stack: weird activation record found on stack: %d",
277 update_fwd_large( bdescr *bd )
280 const StgInfoTable* info;
282 for (; bd != NULL; bd = bd->link) {
285 info = get_itbl((StgClosure *)p);
287 switch (info->type) {
294 case MUT_ARR_PTRS_FROZEN:
299 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
300 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
308 StgTSO *tso = (StgTSO *)p;
309 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
310 thread((StgPtr)&tso->link);
311 thread((StgPtr)&tso->global_link);
318 StgPAP* pap = (StgPAP *)p;
319 thread((StgPtr)&pap->fun);
320 thread_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
325 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
331 update_fwd( bdescr *blocks )
340 barf("update_fwd: ToDo");
343 // cycle through all the blocks in the step
344 for (; bd != NULL; bd = bd->link) {
347 // linearly scan the objects in this block
348 while (p < bd->free) {
350 info = get_itbl((StgClosure *)p);
352 ASSERT(p && (LOOKS_LIKE_GHC_INFO(info)
353 || IS_HUGS_CONSTR_INFO(info)));
355 switch (info->type) {
358 p += sizeofW(StgHeader) + 1;
363 thread((StgPtr)&((StgClosure *)p)->payload[0]);
364 p += sizeofW(StgHeader) + 1;
368 thread((StgPtr)&((StgClosure *)p)->payload[0]);
369 p += sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
372 case THUNK_0_1: // MIN_UPD_SIZE
376 p += sizeofW(StgHeader) + 2;
382 thread((StgPtr)&((StgClosure *)p)->payload[0]);
383 p += sizeofW(StgHeader) + 2;
389 thread((StgPtr)&((StgClosure *)p)->payload[0]);
390 thread((StgPtr)&((StgClosure *)p)->payload[1]);
391 p += sizeofW(StgHeader) + 2;
404 case SE_CAF_BLACKHOLE:
411 end = (P_)((StgClosure *)p)->payload +
412 info->layout.payload.ptrs;
413 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
416 p += info->layout.payload.nptrs;
420 // the info table for a weak ptr lies about the number of ptrs
421 // (because we have special GC routines for them, but we
422 // want to use the standard evacuate code). So we have to
423 // special case here.
426 StgWeak *w = (StgWeak *)p;
427 thread((StgPtr)&w->key);
428 thread((StgPtr)&w->value);
429 thread((StgPtr)&w->finalizer);
430 if (w->link != NULL) {
431 thread((StgPtr)&w->link);
433 p += sizeofW(StgWeak);
437 // again, the info table for MVar isn't suitable here (it includes
438 // the mut_link field as a pointer, and we don't want to
442 StgMVar *mvar = (StgMVar *)p;
443 thread((StgPtr)&mvar->head);
444 thread((StgPtr)&mvar->tail);
445 thread((StgPtr)&mvar->value);
446 p += sizeofW(StgMVar);
451 case IND_OLDGEN_PERM:
452 thread((StgPtr)&((StgIndOldGen *)p)->indirectee);
453 p += sizeofW(StgIndOldGen);
458 StgSelector *s = (StgSelector *)p;
459 thread((StgPtr)&s->selectee);
460 p += THUNK_SELECTOR_sizeW();
464 case AP_UPD: // same as PAPs
467 StgPAP* pap = (StgPAP *)p;
469 thread((P_)&pap->fun);
470 thread_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
476 p += arr_words_sizeW((StgArrWords *)p);
480 case MUT_ARR_PTRS_FROZEN:
485 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
486 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
494 StgTSO *tso = (StgTSO *)p;
495 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
496 thread((StgPtr)&tso->link);
497 thread((StgPtr)&tso->global_link);
503 barf("update_fwd: unknown/strange object %d", (int)(info->type));
510 update_fwd_compact( bdescr *blocks )
514 bdescr *bd, *free_bd;
520 free = free_bd->start;
523 barf("update_fwd: ToDo");
526 // cycle through all the blocks in the step
527 for (; bd != NULL; bd = bd->link) {
530 while (p < bd->free ) {
532 while ( p < bd->free && !is_marked(p,bd) ) {
541 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
542 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
544 while ( p < bd->free ) {
549 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
557 // Problem: we need to know the destination for this cell
558 // in order to unthread its info pointer. But we can't
559 // know the destination without the size, because we may
560 // spill into the next block. So we have to run down the
561 // threaded list and get the info ptr first.
562 info = get_threaded_info(p);
565 ASSERT(p && (LOOKS_LIKE_GHC_INFO(info)
566 || IS_HUGS_CONSTR_INFO(info)));
568 switch (info->type) {
571 p += sizeofW(StgHeader) + 1;
576 thread((StgPtr)&((StgClosure *)p)->payload[0]);
577 p += sizeofW(StgHeader) + 1;
581 thread((StgPtr)&((StgClosure *)p)->payload[0]);
582 p += sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
585 case THUNK_0_1: // MIN_UPD_SIZE
589 p += sizeofW(StgHeader) + 2;
595 thread((StgPtr)&((StgClosure *)p)->payload[0]);
596 p += sizeofW(StgHeader) + 2;
602 thread((StgPtr)&((StgClosure *)p)->payload[0]);
603 thread((StgPtr)&((StgClosure *)p)->payload[1]);
604 p += sizeofW(StgHeader) + 2;
617 case SE_CAF_BLACKHOLE:
624 end = (P_)((StgClosure *)p)->payload +
625 info->layout.payload.ptrs;
626 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
629 p += info->layout.payload.nptrs;
635 StgWeak *w = (StgWeak *)p;
636 thread((StgPtr)&w->key);
637 thread((StgPtr)&w->value);
638 thread((StgPtr)&w->finalizer);
639 if (w->link != NULL) {
640 thread((StgPtr)&w->link);
642 p += sizeofW(StgWeak);
648 StgMVar *mvar = (StgMVar *)p;
649 thread((StgPtr)&mvar->head);
650 thread((StgPtr)&mvar->tail);
651 thread((StgPtr)&mvar->value);
652 p += sizeofW(StgMVar);
657 case IND_OLDGEN_PERM:
658 thread((StgPtr)&((StgIndOldGen *)p)->indirectee);
659 p += sizeofW(StgIndOldGen);
664 StgSelector *s = (StgSelector *)p;
665 thread((StgPtr)&s->selectee);
666 p += THUNK_SELECTOR_sizeW();
670 case AP_UPD: // same as PAPs
673 StgPAP* pap = (StgPAP *)p;
675 thread((P_)&pap->fun);
676 thread_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
682 p += arr_words_sizeW((StgArrWords *)p);
686 case MUT_ARR_PTRS_FROZEN:
691 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
692 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
700 StgTSO *tso = (StgTSO *)p;
701 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
702 thread((StgPtr)&tso->link);
703 thread((StgPtr)&tso->global_link);
709 barf("update_fwd: unknown/strange object %d", (int)(info->type));
713 if (free + size > free_bd->start + BLOCK_SIZE_W) {
714 // unset the next bit in the bitmap to indicate that
715 // this object needs to be pushed into the next
716 // block. This saves us having to run down the
717 // threaded info pointer list twice during the next pass.
719 free_bd = free_bd->link;
720 free = free_bd->start;
722 ASSERT(is_marked(q+1,bd));
735 update_bkwd_compact( step *stp )
739 bdescr *bd, *free_bd;
741 nat size, free_blocks;
743 bd = free_bd = stp->blocks;
744 free = free_bd->start;
748 barf("update_bkwd: ToDo");
751 // cycle through all the blocks in the step
752 for (; bd != NULL; bd = bd->link) {
755 while (p < bd->free ) {
757 while ( p < bd->free && !is_marked(p,bd) ) {
766 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
767 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
769 while ( p < bd->free ) {
774 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
782 if (!is_marked(p+1,bd)) {
783 // don't forget to update the free ptr in the block desc.
784 free_bd->free = free;
785 free_bd = free_bd->link;
786 free = free_bd->start;
791 info = get_itbl((StgClosure *)p);
792 size = obj_sizeW((StgClosure *)p,info);
794 ASSERT(p && (LOOKS_LIKE_GHC_INFO(info)
795 || IS_HUGS_CONSTR_INFO(info)));
801 // Rebuild the mutable list for the old generation.
802 if (ip_MUTABLE(info)) {
803 recordMutable((StgMutClosure *)free);
807 if (info->type == TSO) {
808 move_TSO((StgTSO *)p, (StgTSO *)free);
819 // free the remaining blocks and count what's left.
820 free_bd->free = free;
821 if (free_bd->link != NULL) {
822 freeChain(free_bd->link);
823 free_bd->link = NULL;
825 stp->n_blocks = free_blocks;
831 thread_mut_once_list( generation *g )
833 StgMutClosure *p, *next;
835 for (p = g->mut_once_list; p != END_MUT_LIST; p = next) {
837 thread((StgPtr)&p->mut_link);
840 thread((StgPtr)&g->mut_once_list);
844 compact( void (*get_roots)(evac_fn) )
848 extern StgWeak *old_weak_ptr_list; // tmp
850 // 1. thread the roots
851 get_roots((evac_fn)thread);
853 // the weak pointer lists...
854 if (weak_ptr_list != NULL) {
855 thread((StgPtr)&weak_ptr_list);
857 if (old_weak_ptr_list != NULL) {
858 thread((StgPtr)&old_weak_ptr_list); // tmp
862 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
863 thread((StgPtr)&generations[g].mut_list);
864 thread_mut_once_list(&generations[g]);
867 // the global thread list
868 thread((StgPtr)&all_threads);
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;