1 /* -----------------------------------------------------------------------------
2 * $Id: GCCompact.c,v 1.11 2001/12/11 12:03:23 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"
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 )
516 bdescr *bd, *free_bd;
522 free = free_bd->start;
525 barf("update_fwd: ToDo");
528 // cycle through all the blocks in the step
529 for (; bd != NULL; bd = bd->link) {
532 while (p < bd->free ) {
534 while ( p < bd->free && !is_marked(p,bd) ) {
543 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
544 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
546 while ( p < bd->free ) {
551 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
559 // Problem: we need to know the destination for this cell
560 // in order to unthread its info pointer. But we can't
561 // know the destination without the size, because we may
562 // spill into the next block. So we have to run down the
563 // threaded list and get the info ptr first.
564 info = get_threaded_info(p);
567 ASSERT(p && (LOOKS_LIKE_GHC_INFO(info)
568 || IS_HUGS_CONSTR_INFO(info)));
570 switch (info->type) {
573 p += sizeofW(StgHeader) + 1;
578 thread((StgPtr)&((StgClosure *)p)->payload[0]);
579 p += sizeofW(StgHeader) + 1;
583 thread((StgPtr)&((StgClosure *)p)->payload[0]);
584 p += sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
587 case THUNK_0_1: // MIN_UPD_SIZE
591 p += sizeofW(StgHeader) + 2;
597 thread((StgPtr)&((StgClosure *)p)->payload[0]);
598 p += sizeofW(StgHeader) + 2;
604 thread((StgPtr)&((StgClosure *)p)->payload[0]);
605 thread((StgPtr)&((StgClosure *)p)->payload[1]);
606 p += sizeofW(StgHeader) + 2;
619 case SE_CAF_BLACKHOLE:
626 end = (P_)((StgClosure *)p)->payload +
627 info->layout.payload.ptrs;
628 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
631 p += info->layout.payload.nptrs;
637 StgWeak *w = (StgWeak *)p;
638 thread((StgPtr)&w->key);
639 thread((StgPtr)&w->value);
640 thread((StgPtr)&w->finalizer);
641 if (w->link != NULL) {
642 thread((StgPtr)&w->link);
644 p += sizeofW(StgWeak);
650 StgMVar *mvar = (StgMVar *)p;
651 thread((StgPtr)&mvar->head);
652 thread((StgPtr)&mvar->tail);
653 thread((StgPtr)&mvar->value);
654 p += sizeofW(StgMVar);
659 case IND_OLDGEN_PERM:
660 thread((StgPtr)&((StgIndOldGen *)p)->indirectee);
661 p += sizeofW(StgIndOldGen);
666 StgSelector *s = (StgSelector *)p;
667 thread((StgPtr)&s->selectee);
668 p += THUNK_SELECTOR_sizeW();
672 case AP_UPD: // same as PAPs
675 StgPAP* pap = (StgPAP *)p;
677 thread((P_)&pap->fun);
678 thread_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
684 p += arr_words_sizeW((StgArrWords *)p);
688 case MUT_ARR_PTRS_FROZEN:
693 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
694 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
702 StgTSO *tso = (StgTSO *)p;
703 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
704 thread((StgPtr)&tso->link);
705 thread((StgPtr)&tso->global_link);
711 barf("update_fwd: unknown/strange object %d", (int)(info->type));
715 if (free + size > free_bd->start + BLOCK_SIZE_W) {
716 // unset the next bit in the bitmap to indicate that
717 // this object needs to be pushed into the next
718 // block. This saves us having to run down the
719 // threaded info pointer list twice during the next pass.
721 free_bd = free_bd->link;
722 free = free_bd->start;
724 ASSERT(is_marked(q+1,bd));
737 update_bkwd_compact( step *stp )
743 bdescr *bd, *free_bd;
745 nat size, free_blocks;
747 bd = free_bd = stp->blocks;
748 free = free_bd->start;
752 barf("update_bkwd: ToDo");
755 // cycle through all the blocks in the step
756 for (; bd != NULL; bd = bd->link) {
759 while (p < bd->free ) {
761 while ( p < bd->free && !is_marked(p,bd) ) {
770 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
771 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
773 while ( p < bd->free ) {
778 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
786 if (!is_marked(p+1,bd)) {
787 // don't forget to update the free ptr in the block desc.
788 free_bd->free = free;
789 free_bd = free_bd->link;
790 free = free_bd->start;
795 info = get_itbl((StgClosure *)p);
796 size = obj_sizeW((StgClosure *)p,info);
798 ASSERT(p && (LOOKS_LIKE_GHC_INFO(info)
799 || IS_HUGS_CONSTR_INFO(info)));
805 // Rebuild the mutable list for the old generation.
806 if (ip_MUTABLE(info)) {
807 recordMutable((StgMutClosure *)free);
811 if (info->type == TSO) {
812 move_TSO((StgTSO *)p, (StgTSO *)free);
823 // free the remaining blocks and count what's left.
824 free_bd->free = free;
825 if (free_bd->link != NULL) {
826 freeChain(free_bd->link);
827 free_bd->link = NULL;
829 stp->n_blocks = free_blocks;
835 thread_mut_once_list( generation *g )
837 StgMutClosure *p, *next;
839 for (p = g->mut_once_list; p != END_MUT_LIST; p = next) {
841 thread((StgPtr)&p->mut_link);
844 thread((StgPtr)&g->mut_once_list);
848 compact( void (*get_roots)(evac_fn) )
852 extern StgWeak *old_weak_ptr_list; // tmp
854 // 1. thread the roots
855 get_roots((evac_fn)thread);
857 // the weak pointer lists...
858 if (weak_ptr_list != NULL) {
859 thread((StgPtr)&weak_ptr_list);
861 if (old_weak_ptr_list != NULL) {
862 thread((StgPtr)&old_weak_ptr_list); // tmp
866 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
867 thread((StgPtr)&generations[g].mut_list);
868 thread_mut_once_list(&generations[g]);
871 // the global thread list
872 thread((StgPtr)&all_threads);
874 // the static objects
875 thread_static(scavenged_static_objects);
877 // the stable pointer table
878 threadStablePtrTable((evac_fn)thread);
880 // the CAF list (used by GHCi)
881 markCAFs((evac_fn)thread);
883 // 2. update forward ptrs
884 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
885 for (s = 0; s < generations[g].n_steps; s++) {
886 stp = &generations[g].steps[s];
887 IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d\n", stp->gen->no, stp->no););
889 update_fwd(stp->to_blocks);
890 update_fwd_large(stp->scavenged_large_objects);
891 if (g == RtsFlags.GcFlags.generations-1 && stp->blocks != NULL) {
892 IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
893 update_fwd_compact(stp->blocks);
898 // 3. update backward ptrs
899 stp = &oldest_gen->steps[0];
900 if (stp->blocks != NULL) {
901 blocks = update_bkwd_compact(stp);
902 IF_DEBUG(gc, fprintf(stderr,"update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n",
903 stp->gen->no, stp->no,
904 stp->n_blocks, blocks););
905 stp->n_blocks = blocks;