1 /* -----------------------------------------------------------------------------
2 * $Id: GCCompact.c,v 1.7 2001/08/08 13:44:13 simonmar Exp $
4 * (c) The GHC Team 2001
6 * Compacting garbage collector
8 * ---------------------------------------------------------------------------*/
14 #include "BlockAlloc.h"
16 #include "GCCompact.h"
18 #include "StablePriv.h"
20 /* -----------------------------------------------------------------------------
21 Threading / unthreading pointers.
23 The basic idea here is to chain together all the fields pointing at
24 a particular object, with the root of the chain in the object's
25 info table field. The original contents of the info pointer goes
26 at the end of the chain.
28 Adding a new field to the chain is a matter of swapping the
29 contents of the field with the contents of the object's info table
32 To unthread the chain, we walk down it updating all the fields on
33 the chain with the new location of the object. We stop when we
34 reach the info pointer at the end.
36 We use a trick to identify the info pointer, because the
37 LOOKS_LIKE_GHC_INFO() macro involves a function call and can be
38 expensive. The trick is that when swapping pointers for threading,
39 we set the low bit of the original pointer, with the result that
40 all the pointers in the chain have their low bits set except for
42 -------------------------------------------------------------------------- */
47 StgPtr q = (StgPtr)*p;
50 ASSERT(!LOOKS_LIKE_GHC_INFO(q));
51 if (HEAP_ALLOCED(q)) {
53 // a handy way to discover whether the ptr is into the
54 // compacted area of the old gen, is that the EVACUATED flag
55 // is zero (it's non-zero for all the other areas of live
57 if ((bd->flags & BF_EVACUATED) == 0) {
59 *q = (StgWord)p + 1; // set the low bit
65 unthread( StgPtr p, StgPtr free )
67 StgPtr q = (StgPtr)*p, r;
69 while (((StgWord)q & 1) != 0) {
70 (StgWord)q -= 1; // unset the low bit again
78 static inline StgInfoTable *
79 get_threaded_info( StgPtr p )
81 StgPtr q = (P_)GET_INFO((StgClosure *)p);
83 while (((StgWord)q & 1) != 0) {
84 q = (P_)*((StgPtr)((StgWord)q-1));
86 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
89 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
90 // Remember, the two regions *might* overlap, but: to <= from.
92 move(StgPtr to, StgPtr from, nat size)
94 for(; size > 0; --size) {
100 obj_sizeW( StgClosure *p, StgInfoTable *info )
102 switch (info->type) {
107 return sizeofW(StgHeader) + 1;
119 return sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
121 return THUNK_SELECTOR_sizeW();
124 return pap_sizeW((StgPAP *)p);
126 return arr_words_sizeW((StgArrWords *)p);
128 case MUT_ARR_PTRS_FROZEN:
129 return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
131 return tso_sizeW((StgTSO *)p);
133 return sizeW_fromITBL(info);
138 thread_static( StgClosure* p )
140 const StgInfoTable *info;
142 // keep going until we've threaded all the objects on the linked
144 while (p != END_OF_STATIC_LIST) {
147 switch (info->type) {
150 thread((StgPtr)&((StgInd *)p)->indirectee);
151 p = IND_STATIC_LINK(p);
155 p = THUNK_STATIC_LINK(p);
158 p = FUN_STATIC_LINK(p);
161 p = STATIC_LINK(info,p);
165 barf("thread_static: strange closure %d", (int)(info->type));
172 thread_stack(StgPtr p, StgPtr stack_end)
175 const StgInfoTable* info;
178 // highly similar to scavenge_stack, but we do pointer threading here.
180 while (p < stack_end) {
183 // If we've got a tag, skip over that many words on the stack
184 if ( IS_ARG_TAG((W_)q) ) {
189 // Is q a pointer to a closure?
190 if ( !LOOKS_LIKE_GHC_INFO(q) ) {
196 // Otherwise, q must be the info pointer of an activation
197 // record. All activation records have 'bitmap' style layout
200 info = get_itbl((StgClosure *)p);
202 switch (info->type) {
204 // Dynamic bitmap: the mask is stored on the stack
206 bitmap = ((StgRetDyn *)p)->liveness;
207 p = (P_)&((StgRetDyn *)p)->payload[0];
210 // probably a slow-entry point return address:
216 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
224 bitmap = info->layout.bitmap;
226 // this assumes that the payload starts immediately after the info-ptr
228 while (bitmap != 0) {
229 if ((bitmap & 1) == 0) {
233 bitmap = bitmap >> 1;
237 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
242 StgLargeBitmap *large_bitmap;
245 large_bitmap = info->layout.large_bitmap;
248 for (i=0; i<large_bitmap->size; i++) {
249 bitmap = large_bitmap->bitmap[i];
251 while (bitmap != 0) {
252 if ((bitmap & 1) == 0) {
256 bitmap = bitmap >> 1;
258 if (i+1 < large_bitmap->size) {
269 barf("thread_stack: weird activation record found on stack: %d",
276 update_fwd_large( bdescr *bd )
279 const StgInfoTable* info;
281 for (; bd != NULL; bd = bd->link) {
284 info = get_itbl((StgClosure *)p);
286 switch (info->type) {
293 case MUT_ARR_PTRS_FROZEN:
298 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
299 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
307 StgTSO *tso = (StgTSO *)p;
308 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
309 thread((StgPtr)&tso->link);
310 thread((StgPtr)&tso->global_link);
317 StgPAP* pap = (StgPAP *)p;
318 thread((StgPtr)&pap->fun);
319 thread_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
324 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
330 update_fwd( bdescr *blocks )
339 barf("update_fwd: ToDo");
342 // cycle through all the blocks in the step
343 for (; bd != NULL; bd = bd->link) {
346 // linearly scan the objects in this block
347 while (p < bd->free) {
349 info = get_itbl((StgClosure *)p);
351 ASSERT(p && (LOOKS_LIKE_GHC_INFO(info)
352 || IS_HUGS_CONSTR_INFO(info)));
354 switch (info->type) {
357 p += sizeofW(StgHeader) + 1;
362 thread((StgPtr)&((StgClosure *)p)->payload[0]);
363 p += sizeofW(StgHeader) + 1;
367 thread((StgPtr)&((StgClosure *)p)->payload[0]);
368 p += sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
371 case THUNK_0_1: // MIN_UPD_SIZE
375 p += sizeofW(StgHeader) + 2;
381 thread((StgPtr)&((StgClosure *)p)->payload[0]);
382 p += sizeofW(StgHeader) + 2;
388 thread((StgPtr)&((StgClosure *)p)->payload[0]);
389 thread((StgPtr)&((StgClosure *)p)->payload[1]);
390 p += sizeofW(StgHeader) + 2;
403 case SE_CAF_BLACKHOLE:
410 end = (P_)((StgClosure *)p)->payload +
411 info->layout.payload.ptrs;
412 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
415 p += info->layout.payload.nptrs;
419 // the info table for a weak ptr lies about the number of ptrs
420 // (because we have special GC routines for them, but we
421 // want to use the standard evacuate code). So we have to
422 // special case here.
425 StgWeak *w = (StgWeak *)p;
426 thread((StgPtr)&w->key);
427 thread((StgPtr)&w->value);
428 thread((StgPtr)&w->finalizer);
429 if (w->link != NULL) {
430 thread((StgPtr)&w->link);
432 p += sizeofW(StgWeak);
436 // again, the info table for MVar isn't suitable here (it includes
437 // the mut_link field as a pointer, and we don't want to
441 StgMVar *mvar = (StgMVar *)p;
442 thread((StgPtr)&mvar->head);
443 thread((StgPtr)&mvar->tail);
444 thread((StgPtr)&mvar->value);
445 p += sizeofW(StgMVar);
449 // specialise this case, because we want to update the
450 // mut_link field too.
452 case IND_OLDGEN_PERM:
454 StgIndOldGen *ind = (StgIndOldGen *)p;
455 thread((StgPtr)&ind->indirectee);
456 if (ind->mut_link != NULL) {
457 thread((StgPtr)&ind->mut_link);
464 StgSelector *s = (StgSelector *)p;
465 thread((StgPtr)&s->selectee);
466 p += THUNK_SELECTOR_sizeW();
470 case AP_UPD: // same as PAPs
473 StgPAP* pap = (StgPAP *)p;
475 thread((P_)&pap->fun);
476 thread_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
482 p += arr_words_sizeW((StgArrWords *)p);
486 case MUT_ARR_PTRS_FROZEN:
491 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
492 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
500 StgTSO *tso = (StgTSO *)p;
501 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
502 thread((StgPtr)&tso->link);
503 thread((StgPtr)&tso->global_link);
509 barf("update_fwd: unknown/strange object %d", (int)(info->type));
516 update_fwd_compact( bdescr *blocks )
520 bdescr *bd, *free_bd;
526 free = free_bd->start;
529 barf("update_fwd: ToDo");
532 // cycle through all the blocks in the step
533 for (; bd != NULL; bd = bd->link) {
536 while (p < bd->free ) {
538 while ( p < bd->free && !is_marked(p,bd) ) {
547 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
548 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
550 while ( p < bd->free ) {
555 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
563 // Problem: we need to know the destination for this cell
564 // in order to unthread its info pointer. But we can't
565 // know the destination without the size, because we may
566 // spill into the next block. So we have to run down the
567 // threaded list and get the info ptr first.
568 info = get_threaded_info(p);
571 ASSERT(p && (LOOKS_LIKE_GHC_INFO(info)
572 || IS_HUGS_CONSTR_INFO(info)));
574 switch (info->type) {
577 p += sizeofW(StgHeader) + 1;
582 thread((StgPtr)&((StgClosure *)p)->payload[0]);
583 p += sizeofW(StgHeader) + 1;
587 thread((StgPtr)&((StgClosure *)p)->payload[0]);
588 p += sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
591 case THUNK_0_1: // MIN_UPD_SIZE
595 p += sizeofW(StgHeader) + 2;
601 thread((StgPtr)&((StgClosure *)p)->payload[0]);
602 p += sizeofW(StgHeader) + 2;
608 thread((StgPtr)&((StgClosure *)p)->payload[0]);
609 thread((StgPtr)&((StgClosure *)p)->payload[1]);
610 p += sizeofW(StgHeader) + 2;
623 case SE_CAF_BLACKHOLE:
630 end = (P_)((StgClosure *)p)->payload +
631 info->layout.payload.ptrs;
632 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
635 p += info->layout.payload.nptrs;
641 StgWeak *w = (StgWeak *)p;
642 thread((StgPtr)&w->key);
643 thread((StgPtr)&w->value);
644 thread((StgPtr)&w->finalizer);
645 if (w->link != NULL) {
646 thread((StgPtr)&w->link);
648 p += sizeofW(StgWeak);
654 StgMVar *mvar = (StgMVar *)p;
655 thread((StgPtr)&mvar->head);
656 thread((StgPtr)&mvar->tail);
657 thread((StgPtr)&mvar->value);
658 p += sizeofW(StgMVar);
663 case IND_OLDGEN_PERM:
664 // specialise this case, because we want to update the
665 // mut_link field too.
667 StgIndOldGen *ind = (StgIndOldGen *)p;
668 thread((StgPtr)&ind->indirectee);
669 if (ind->mut_link != NULL) {
670 thread((StgPtr)&ind->mut_link);
672 p += sizeofW(StgIndOldGen);
678 StgSelector *s = (StgSelector *)p;
679 thread((StgPtr)&s->selectee);
680 p += THUNK_SELECTOR_sizeW();
684 case AP_UPD: // same as PAPs
687 StgPAP* pap = (StgPAP *)p;
689 thread((P_)&pap->fun);
690 thread_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
696 p += arr_words_sizeW((StgArrWords *)p);
700 case MUT_ARR_PTRS_FROZEN:
705 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
706 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
714 StgTSO *tso = (StgTSO *)p;
715 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
716 thread((StgPtr)&tso->link);
717 thread((StgPtr)&tso->global_link);
723 barf("update_fwd: unknown/strange object %d", (int)(info->type));
727 if (free + size > free_bd->start + BLOCK_SIZE_W) {
728 // unset the next bit in the bitmap to indicate that
729 // this object needs to be pushed into the next
730 // block. This saves us having to run down the
731 // threaded info pointer list twice during the next pass.
733 free_bd = free_bd->link;
734 free = free_bd->start;
736 ASSERT(is_marked(q+1,bd));
749 update_bkwd_compact( step *stp )
753 bdescr *bd, *free_bd;
755 nat size, free_blocks;
757 bd = free_bd = stp->blocks;
758 free = free_bd->start;
762 barf("update_bkwd: ToDo");
765 // cycle through all the blocks in the step
766 for (; bd != NULL; bd = bd->link) {
769 while (p < bd->free ) {
771 while ( p < bd->free && !is_marked(p,bd) ) {
780 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
781 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
783 while ( p < bd->free ) {
788 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
796 if (!is_marked(p+1,bd)) {
797 // don't forget to update the free ptr in the block desc.
798 free_bd->free = free;
799 free_bd = free_bd->link;
800 free = free_bd->start;
805 info = get_itbl((StgClosure *)p);
806 size = obj_sizeW((StgClosure *)p,info);
808 ASSERT(p && (LOOKS_LIKE_GHC_INFO(info)
809 || IS_HUGS_CONSTR_INFO(info)));
815 // Rebuild the mutable list for the old generation.
816 // (the mut_once list is updated using threading, with
817 // special cases for IND_OLDGEN and MUT_CONS above).
818 if (ip_MUTABLE(info)) {
819 recordMutable((StgMutClosure *)free);
823 if (info->type == TSO) {
824 move_TSO((StgTSO *)p, (StgTSO *)free);
835 // free the remaining blocks and count what's left.
836 free_bd->free = free;
837 if (free_bd->link != NULL) {
838 freeChain(free_bd->link);
839 free_bd->link = NULL;
841 stp->n_blocks = free_blocks;
847 compact( void (*get_roots)(evac_fn) )
851 extern StgWeak *old_weak_ptr_list; // tmp
853 // 1. thread the roots
854 get_roots((evac_fn)thread);
856 // the weak pointer lists...
857 if (weak_ptr_list != NULL) {
858 thread((StgPtr)&weak_ptr_list);
860 if (old_weak_ptr_list != NULL) {
861 thread((StgPtr)&old_weak_ptr_list); // tmp
865 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
866 thread((StgPtr)&generations[g].mut_list);
867 thread((StgPtr)&generations[g].mut_once_list);
870 // the global thread list
871 thread((StgPtr)&all_threads);
873 // the static objects
874 thread_static(scavenged_static_objects);
876 // the stable pointer table
877 threadStablePtrTable((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;