1 /* -----------------------------------------------------------------------------
2 * $Id: GCCompact.c,v 1.3 2001/07/24 15:13:01 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);
159 barf("thread_static: strange closure %d", (int)(info->type));
162 p = STATIC_LINK(info,p);
167 thread_stack(StgPtr p, StgPtr stack_end)
170 const StgInfoTable* info;
173 // highly similar to scavenge_stack, but we do pointer threading here.
175 while (p < stack_end) {
178 // If we've got a tag, skip over that many words on the stack
179 if ( IS_ARG_TAG((W_)q) ) {
184 // Is q a pointer to a closure?
185 if ( !LOOKS_LIKE_GHC_INFO(q) ) {
191 // Otherwise, q must be the info pointer of an activation
192 // record. All activation records have 'bitmap' style layout
195 info = get_itbl((StgClosure *)p);
197 switch (info->type) {
199 // Dynamic bitmap: the mask is stored on the stack
201 bitmap = ((StgRetDyn *)p)->liveness;
202 p = (P_)&((StgRetDyn *)p)->payload[0];
205 // probably a slow-entry point return address:
211 // small bitmap (< 32 entries, or 64 on a 64-bit machine)
219 bitmap = info->layout.bitmap;
221 // this assumes that the payload starts immediately after the info-ptr
223 while (bitmap != 0) {
224 if ((bitmap & 1) == 0) {
228 bitmap = bitmap >> 1;
232 // large bitmap (> 32 entries)
237 StgLargeBitmap *large_bitmap;
240 large_bitmap = info->layout.large_bitmap;
243 for (i=0; i<large_bitmap->size; i++) {
244 bitmap = large_bitmap->bitmap[i];
245 q = p + sizeof(W_) * 8;
246 while (bitmap != 0) {
247 if ((bitmap & 1) == 0) {
251 bitmap = bitmap >> 1;
253 if (i+1 < large_bitmap->size) {
264 barf("thread_stack: weird activation record found on stack: %d",
271 update_fwd_large( bdescr *bd )
274 const StgInfoTable* info;
276 for (; bd != NULL; bd = bd->link) {
279 info = get_itbl((StgClosure *)p);
281 switch (info->type) {
288 case MUT_ARR_PTRS_FROZEN:
293 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
294 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
302 StgTSO *tso = (StgTSO *)p;
303 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
310 StgPAP* pap = (StgPAP *)p;
311 thread((StgPtr)&pap->fun);
312 thread_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
317 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
323 update_fwd( bdescr *blocks )
332 barf("update_fwd: ToDo");
335 // cycle through all the blocks in the step
336 for (; bd != NULL; bd = bd->link) {
339 // linearly scan the objects in this block
340 while (p < bd->free) {
342 info = get_itbl((StgClosure *)p);
344 ASSERT(p && (LOOKS_LIKE_GHC_INFO(info)
345 || IS_HUGS_CONSTR_INFO(info)));
347 switch (info->type) {
350 p += sizeofW(StgHeader) + 1;
355 thread((StgPtr)&((StgClosure *)p)->payload[0]);
356 p += sizeofW(StgHeader) + 1;
360 thread((StgPtr)&((StgClosure *)p)->payload[0]);
361 p += sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
364 case THUNK_0_1: // MIN_UPD_SIZE
368 p += sizeofW(StgHeader) + 2;
374 thread((StgPtr)&((StgClosure *)p)->payload[0]);
375 p += sizeofW(StgHeader) + 2;
381 thread((StgPtr)&((StgClosure *)p)->payload[0]);
382 thread((StgPtr)&((StgClosure *)p)->payload[1]);
383 p += sizeofW(StgHeader) + 2;
396 case SE_CAF_BLACKHOLE:
403 end = (P_)((StgClosure *)p)->payload +
404 info->layout.payload.ptrs;
405 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
408 p += info->layout.payload.nptrs;
412 // the info table for a weak ptr lies about the number of ptrs
413 // (because we have special GC routines for them, but we
414 // want to use the standard evacuate code). So we have to
415 // special case here.
418 StgWeak *w = (StgWeak *)p;
419 thread((StgPtr)&w->key);
420 thread((StgPtr)&w->value);
421 thread((StgPtr)&w->finalizer);
422 if (w->link != NULL) {
423 thread((StgPtr)&w->link);
425 p += sizeofW(StgWeak);
429 // again, the info table for MVar isn't suitable here (it includes
430 // the mut_link field as a pointer, and we don't want to
434 StgMVar *mvar = (StgMVar *)p;
435 thread((StgPtr)&mvar->head);
436 thread((StgPtr)&mvar->tail);
437 thread((StgPtr)&mvar->value);
438 p += sizeofW(StgMVar);
442 // specialise this case, because we want to update the
443 // mut_link field too.
445 case IND_OLDGEN_PERM:
447 StgIndOldGen *ind = (StgIndOldGen *)p;
448 thread((StgPtr)&ind->indirectee);
449 if (ind->mut_link != NULL) {
450 thread((StgPtr)&ind->mut_link);
457 StgSelector *s = (StgSelector *)p;
458 thread((StgPtr)&s->selectee);
459 p += THUNK_SELECTOR_sizeW();
463 case AP_UPD: // same as PAPs
466 StgPAP* pap = (StgPAP *)p;
468 thread((P_)&pap->fun);
469 thread_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
475 p += arr_words_sizeW((StgArrWords *)p);
479 case MUT_ARR_PTRS_FROZEN:
484 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
485 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
493 StgTSO *tso = (StgTSO *)p;
494 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
495 thread((StgPtr)&tso->link);
496 thread((StgPtr)&tso->global_link);
502 barf("update_fwd: unknown/strange object %d", (int)(info->type));
509 update_fwd_compact( bdescr *blocks )
513 bdescr *bd, *free_bd;
519 free = free_bd->start;
522 barf("update_fwd: ToDo");
525 // cycle through all the blocks in the step
526 for (; bd != NULL; bd = bd->link) {
529 while (p < bd->free ) {
531 while ( p < bd->free && !is_marked(p,bd) ) {
540 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
541 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
543 while ( p < bd->free ) {
548 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
556 // Problem: we need to know the destination for this cell
557 // in order to unthread its info pointer. But we can't
558 // know the destination without the size, because we may
559 // spill into the next block. So we have to run down the
560 // threaded list and get the info ptr first.
561 info = get_threaded_info(p);
564 ASSERT(p && (LOOKS_LIKE_GHC_INFO(info)
565 || IS_HUGS_CONSTR_INFO(info)));
567 switch (info->type) {
570 p += sizeofW(StgHeader) + 1;
575 thread((StgPtr)&((StgClosure *)p)->payload[0]);
576 p += sizeofW(StgHeader) + 1;
580 thread((StgPtr)&((StgClosure *)p)->payload[0]);
581 p += sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
584 case THUNK_0_1: // MIN_UPD_SIZE
588 p += sizeofW(StgHeader) + 2;
594 thread((StgPtr)&((StgClosure *)p)->payload[0]);
595 p += sizeofW(StgHeader) + 2;
601 thread((StgPtr)&((StgClosure *)p)->payload[0]);
602 thread((StgPtr)&((StgClosure *)p)->payload[1]);
603 p += sizeofW(StgHeader) + 2;
616 case SE_CAF_BLACKHOLE:
623 end = (P_)((StgClosure *)p)->payload +
624 info->layout.payload.ptrs;
625 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
628 p += info->layout.payload.nptrs;
634 StgWeak *w = (StgWeak *)p;
635 thread((StgPtr)&w->key);
636 thread((StgPtr)&w->value);
637 thread((StgPtr)&w->finalizer);
638 if (w->link != NULL) {
639 thread((StgPtr)&w->link);
641 p += sizeofW(StgWeak);
647 StgMVar *mvar = (StgMVar *)p;
648 thread((StgPtr)&mvar->head);
649 thread((StgPtr)&mvar->tail);
650 thread((StgPtr)&mvar->value);
651 p += sizeofW(StgMVar);
656 case IND_OLDGEN_PERM:
657 // specialise this case, because we want to update the
658 // mut_link field too.
660 StgIndOldGen *ind = (StgIndOldGen *)p;
661 thread((StgPtr)&ind->indirectee);
662 if (ind->mut_link != NULL) {
663 thread((StgPtr)&ind->mut_link);
665 p += sizeofW(StgIndOldGen);
671 StgSelector *s = (StgSelector *)p;
672 thread((StgPtr)&s->selectee);
673 p += THUNK_SELECTOR_sizeW();
677 case AP_UPD: // same as PAPs
680 StgPAP* pap = (StgPAP *)p;
682 thread((P_)&pap->fun);
683 thread_stack((P_)pap->payload, (P_)pap->payload + pap->n_args);
689 p += arr_words_sizeW((StgArrWords *)p);
693 case MUT_ARR_PTRS_FROZEN:
698 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
699 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
707 StgTSO *tso = (StgTSO *)p;
708 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
709 thread((StgPtr)&tso->link);
710 thread((StgPtr)&tso->global_link);
716 barf("update_fwd: unknown/strange object %d", (int)(info->type));
720 if (free + size > free_bd->start + BLOCK_SIZE_W) {
721 free_bd = free_bd->link;
722 free = free_bd->start;
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 // must unthread before we look at the info ptr...
783 info = get_threaded_info(p);
785 ASSERT(p && (LOOKS_LIKE_GHC_INFO(info)
786 || IS_HUGS_CONSTR_INFO(info)));
788 size = obj_sizeW((StgClosure *)p,info);
790 if (free + size > free_bd->start + BLOCK_SIZE_W) {
791 // don't forget to update the free ptr in the block desc.
792 free_bd->free = free;
793 free_bd = free_bd->link;
794 free = free_bd->start;
803 // Rebuild the mutable list for the old generation.
804 // (the mut_once list is updated using threading, with
805 // special cases for IND_OLDGEN and MUT_CONS above).
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 compact( void (*get_roots)(evac_fn) )
839 extern StgWeak *old_weak_ptr_list; // tmp
841 // 1. thread the roots
842 get_roots((evac_fn)thread);
844 // the weak pointer lists...
845 if (weak_ptr_list != NULL) {
846 thread((StgPtr)&weak_ptr_list);
848 if (old_weak_ptr_list != NULL) {
849 thread((StgPtr)&old_weak_ptr_list); // tmp
853 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
854 thread((StgPtr)&generations[g].mut_list);
855 thread((StgPtr)&generations[g].mut_once_list);
858 // the global thread list
859 thread((StgPtr)&all_threads);
861 // the static objects
862 thread_static(scavenged_static_objects);
864 // the stable pointer table
865 threadStablePtrTable((evac_fn)thread);
867 // 2. update forward ptrs
868 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
869 for (s = 0; s < generations[g].n_steps; s++) {
870 stp = &generations[g].steps[s];
871 IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d\n", stp->gen->no, stp->no););
873 update_fwd(stp->to_blocks);
874 update_fwd_large(stp->scavenged_large_objects);
875 if (g == RtsFlags.GcFlags.generations-1 && stp->blocks != NULL) {
876 IF_DEBUG(gc, fprintf(stderr,"update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
877 update_fwd_compact(stp->blocks);
882 // 3. update backward ptrs
883 stp = &oldest_gen->steps[0];
884 if (stp->blocks != NULL) {
885 blocks = update_bkwd_compact(stp);
886 IF_DEBUG(gc, fprintf(stderr,"update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n",
887 stp->gen->no, stp->no,
888 stp->n_blocks, blocks););
889 stp->n_blocks = blocks;