1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team 2001
5 * Compacting garbage collector
7 * ---------------------------------------------------------------------------*/
9 #include "PosixSource.h"
13 #include "OSThreads.h"
15 #include "BlockAlloc.h"
17 #include "GCCompact.h"
21 // Turn off inlining when debugging - it obfuscates things
24 # define STATIC_INLINE static
27 /* -----------------------------------------------------------------------------
28 Threading / unthreading pointers.
30 The basic idea here is to chain together all the fields pointing at
31 a particular object, with the root of the chain in the object's
32 info table field. The original contents of the info pointer goes
33 at the end of the chain.
35 Adding a new field to the chain is a matter of swapping the
36 contents of the field with the contents of the object's info table
39 To unthread the chain, we walk down it updating all the fields on
40 the chain with the new location of the object. We stop when we
41 reach the info pointer at the end.
43 We use a trick to identify the info pointer: when swapping pointers
44 for threading, we set the low bit of the original pointer, with the
45 result that all the pointers in the chain have their low bits set
46 except for the info pointer.
47 -------------------------------------------------------------------------- */
52 StgPtr q = (StgPtr)*p;
55 // It doesn't look like a closure at the moment, because the info
56 // ptr is possibly threaded:
57 // ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
59 if (HEAP_ALLOCED(q)) {
61 // a handy way to discover whether the ptr is into the
62 // compacted area of the old gen, is that the EVACUATED flag
63 // is zero (it's non-zero for all the other areas of live
65 if ((bd->flags & BF_EVACUATED) == 0) {
67 *q = (StgWord)p + 1; // set the low bit
73 unthread( StgPtr p, StgPtr free )
77 while ((q & 1) != 0) {
78 q -= 1; // unset the low bit again
80 *((StgPtr)q) = (StgWord)free;
86 STATIC_INLINE StgInfoTable *
87 get_threaded_info( StgPtr p )
89 StgPtr q = (P_)GET_INFO((StgClosure *)p);
91 while (((StgWord)q & 1) != 0) {
92 q = (P_)*((StgPtr)((StgWord)q-1));
95 ASSERT(LOOKS_LIKE_INFO_PTR(q));
96 return INFO_PTR_TO_STRUCT((StgInfoTable *)q);
99 // A word-aligned memmove will be faster for small objects than libc's or gcc's.
100 // Remember, the two regions *might* overlap, but: to <= from.
102 move(StgPtr to, StgPtr from, nat size)
104 for(; size > 0; --size) {
110 thread_static( StgClosure* p )
112 const StgInfoTable *info;
114 // keep going until we've threaded all the objects on the linked
116 while (p != END_OF_STATIC_LIST) {
119 switch (info->type) {
122 thread((StgPtr)&((StgInd *)p)->indirectee);
123 p = *IND_STATIC_LINK(p);
127 p = *THUNK_STATIC_LINK(p);
130 p = *FUN_STATIC_LINK(p);
133 p = *STATIC_LINK(info,p);
137 barf("thread_static: strange closure %d", (int)(info->type));
144 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
150 bitmap = large_bitmap->bitmap[b];
151 for (i = 0; i < size; ) {
152 if ((bitmap & 1) == 0) {
157 if (i % BITS_IN(W_) == 0) {
159 bitmap = large_bitmap->bitmap[b];
161 bitmap = bitmap >> 1;
167 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
174 switch (fun_info->f.fun_type) {
176 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
177 size = BITMAP_SIZE(fun_info->f.b.bitmap);
180 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
181 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
185 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
186 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
189 if ((bitmap & 1) == 0) {
193 bitmap = bitmap >> 1;
202 thread_stack(StgPtr p, StgPtr stack_end)
204 const StgRetInfoTable* info;
208 // highly similar to scavenge_stack, but we do pointer threading here.
210 while (p < stack_end) {
212 // *p must be the info pointer of an activation
213 // record. All activation records have 'bitmap' style layout
216 info = get_ret_itbl((StgClosure *)p);
218 switch (info->i.type) {
220 // Dynamic bitmap: the mask is stored on the stack
224 dyn = ((StgRetDyn *)p)->liveness;
226 // traverse the bitmap first
227 bitmap = RET_DYN_LIVENESS(dyn);
228 p = (P_)&((StgRetDyn *)p)->payload[0];
229 size = RET_DYN_BITMAP_SIZE;
231 if ((bitmap & 1) == 0) {
235 bitmap = bitmap >> 1;
239 // skip over the non-ptr words
240 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
242 // follow the ptr words
243 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
250 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
251 case CATCH_RETRY_FRAME:
252 case CATCH_STM_FRAME:
253 case ATOMICALLY_FRAME:
259 bitmap = BITMAP_BITS(info->i.layout.bitmap);
260 size = BITMAP_SIZE(info->i.layout.bitmap);
262 // NOTE: the payload starts immediately after the info-ptr, we
263 // don't have an StgHeader in the same sense as a heap closure.
265 if ((bitmap & 1) == 0) {
269 bitmap = bitmap >> 1;
282 size = BCO_BITMAP_SIZE(bco);
283 thread_large_bitmap(p, BCO_BITMAP(bco), size);
288 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
292 size = GET_LARGE_BITMAP(&info->i)->size;
293 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
299 StgRetFun *ret_fun = (StgRetFun *)p;
300 StgFunInfoTable *fun_info;
302 fun_info = itbl_to_fun_itbl(
303 get_threaded_info((StgPtr)ret_fun->fun));
304 // *before* threading it!
305 thread((StgPtr)&ret_fun->fun);
306 p = thread_arg_block(fun_info, ret_fun->payload);
311 barf("thread_stack: weird activation record found on stack: %d",
312 (int)(info->i.type));
318 thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
322 StgFunInfoTable *fun_info;
324 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)fun));
325 ASSERT(fun_info->i.type != PAP);
329 switch (fun_info->f.fun_type) {
331 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
334 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
338 thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
342 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
345 if ((bitmap & 1) == 0) {
349 bitmap = bitmap >> 1;
359 thread_PAP (StgPAP *pap)
362 p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
363 thread((StgPtr)&pap->fun);
368 thread_AP (StgAP *ap)
371 p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
372 thread((StgPtr)&ap->fun);
377 thread_AP_STACK (StgAP_STACK *ap)
379 thread((StgPtr)&ap->fun);
380 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
381 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
385 thread_TSO (StgTSO *tso)
387 thread((StgPtr)&tso->link);
388 thread((StgPtr)&tso->global_link);
390 if ( tso->why_blocked == BlockedOnMVar
391 || tso->why_blocked == BlockedOnBlackHole
392 || tso->why_blocked == BlockedOnException
394 || tso->why_blocked == BlockedOnGA
395 || tso->why_blocked == BlockedOnGA_NoSend
398 thread((StgPtr)&tso->block_info.closure);
400 if ( tso->blocked_exceptions != NULL ) {
401 thread((StgPtr)&tso->blocked_exceptions);
404 thread((StgPtr)&tso->trec);
406 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
407 return (StgPtr)tso + tso_sizeW(tso);
412 update_fwd_large( bdescr *bd )
415 const StgInfoTable* info;
417 for (; bd != NULL; bd = bd->link) {
420 info = get_itbl((StgClosure *)p);
422 switch (info->type) {
428 case MUT_ARR_PTRS_CLEAN:
429 case MUT_ARR_PTRS_DIRTY:
430 case MUT_ARR_PTRS_FROZEN:
431 case MUT_ARR_PTRS_FROZEN0:
436 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
437 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
444 thread_TSO((StgTSO *)p);
448 thread_AP_STACK((StgAP_STACK *)p);
452 thread_PAP((StgPAP *)p);
458 StgTRecChunk *tc = (StgTRecChunk *)p;
459 TRecEntry *e = &(tc -> entries[0]);
460 thread((StgPtr)&tc->prev_chunk);
461 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
462 thread((StgPtr)&e->tvar);
463 thread((StgPtr)&e->expected_value);
464 thread((StgPtr)&e->new_value);
470 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
476 thread_obj (StgInfoTable *info, StgPtr p)
478 switch (info->type) {
480 return p + sizeofW(StgThunk) + 1;
484 return p + sizeofW(StgHeader) + 1;
488 thread((StgPtr)&((StgClosure *)p)->payload[0]);
489 return p + sizeofW(StgHeader) + 1;
492 thread((StgPtr)&((StgThunk *)p)->payload[0]);
493 return p + sizeofW(StgThunk) + 1;
496 return p + sizeofW(StgThunk) + 2;
500 return p + sizeofW(StgHeader) + 2;
503 thread((StgPtr)&((StgThunk *)p)->payload[0]);
504 return p + sizeofW(StgThunk) + 2;
508 thread((StgPtr)&((StgClosure *)p)->payload[0]);
509 return p + sizeofW(StgHeader) + 2;
512 thread((StgPtr)&((StgThunk *)p)->payload[0]);
513 thread((StgPtr)&((StgThunk *)p)->payload[1]);
514 return p + sizeofW(StgThunk) + 2;
518 thread((StgPtr)&((StgClosure *)p)->payload[0]);
519 thread((StgPtr)&((StgClosure *)p)->payload[1]);
520 return p + sizeofW(StgHeader) + 2;
523 StgBCO *bco = (StgBCO *)p;
524 thread((StgPtr)&bco->instrs);
525 thread((StgPtr)&bco->literals);
526 thread((StgPtr)&bco->ptrs);
527 thread((StgPtr)&bco->itbls);
528 return p + bco_sizeW(bco);
535 end = (P_)((StgThunk *)p)->payload +
536 info->layout.payload.ptrs;
537 for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
540 return p + info->layout.payload.nptrs;
550 case SE_CAF_BLACKHOLE:
556 end = (P_)((StgClosure *)p)->payload +
557 info->layout.payload.ptrs;
558 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
561 return p + info->layout.payload.nptrs;
566 StgWeak *w = (StgWeak *)p;
567 thread((StgPtr)&w->key);
568 thread((StgPtr)&w->value);
569 thread((StgPtr)&w->finalizer);
570 if (w->link != NULL) {
571 thread((StgPtr)&w->link);
573 return p + sizeofW(StgWeak);
578 StgMVar *mvar = (StgMVar *)p;
579 thread((StgPtr)&mvar->head);
580 thread((StgPtr)&mvar->tail);
581 thread((StgPtr)&mvar->value);
582 return p + sizeofW(StgMVar);
586 case IND_OLDGEN_PERM:
587 thread((StgPtr)&((StgInd *)p)->indirectee);
588 return p + sizeofW(StgInd);
592 StgSelector *s = (StgSelector *)p;
593 thread((StgPtr)&s->selectee);
594 return p + THUNK_SELECTOR_sizeW();
598 return thread_AP_STACK((StgAP_STACK *)p);
601 return thread_PAP((StgPAP *)p);
604 return thread_AP((StgAP *)p);
607 return p + arr_words_sizeW((StgArrWords *)p);
609 case MUT_ARR_PTRS_CLEAN:
610 case MUT_ARR_PTRS_DIRTY:
611 case MUT_ARR_PTRS_FROZEN:
612 case MUT_ARR_PTRS_FROZEN0:
617 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
618 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
625 return thread_TSO((StgTSO *)p);
627 case TVAR_WAIT_QUEUE:
629 StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p;
630 thread((StgPtr)&wq->waiting_tso);
631 thread((StgPtr)&wq->next_queue_entry);
632 thread((StgPtr)&wq->prev_queue_entry);
633 return p + sizeofW(StgTVarWaitQueue);
638 StgTVar *tvar = (StgTVar *)p;
639 thread((StgPtr)&tvar->current_value);
640 thread((StgPtr)&tvar->first_wait_queue_entry);
641 return p + sizeofW(StgTVar);
646 StgTRecHeader *trec = (StgTRecHeader *)p;
647 thread((StgPtr)&trec->enclosing_trec);
648 thread((StgPtr)&trec->current_chunk);
649 return p + sizeofW(StgTRecHeader);
655 StgTRecChunk *tc = (StgTRecChunk *)p;
656 TRecEntry *e = &(tc -> entries[0]);
657 thread((StgPtr)&tc->prev_chunk);
658 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
659 thread((StgPtr)&e->tvar);
660 thread((StgPtr)&e->expected_value);
661 thread((StgPtr)&e->new_value);
663 return p + sizeofW(StgTRecChunk);
667 barf("update_fwd: unknown/strange object %d", (int)(info->type));
673 update_fwd( bdescr *blocks )
682 barf("update_fwd: ToDo");
685 // cycle through all the blocks in the step
686 for (; bd != NULL; bd = bd->link) {
689 // linearly scan the objects in this block
690 while (p < bd->free) {
691 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
692 info = get_itbl((StgClosure *)p);
693 p = thread_obj(info, p);
699 update_fwd_compact( bdescr *blocks )
705 bdescr *bd, *free_bd;
711 free = free_bd->start;
714 barf("update_fwd: ToDo");
717 // cycle through all the blocks in the step
718 for (; bd != NULL; bd = bd->link) {
721 while (p < bd->free ) {
723 while ( p < bd->free && !is_marked(p,bd) ) {
732 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
733 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
735 while ( p < bd->free ) {
740 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
748 // Problem: we need to know the destination for this cell
749 // in order to unthread its info pointer. But we can't
750 // know the destination without the size, because we may
751 // spill into the next block. So we have to run down the
752 // threaded list and get the info ptr first.
753 info = get_threaded_info(p);
757 p = thread_obj(info, p);
760 if (free + size > free_bd->start + BLOCK_SIZE_W) {
761 // unset the next bit in the bitmap to indicate that
762 // this object needs to be pushed into the next
763 // block. This saves us having to run down the
764 // threaded info pointer list twice during the next pass.
766 free_bd = free_bd->link;
767 free = free_bd->start;
769 ASSERT(is_marked(q+1,bd));
782 update_bkwd_compact( step *stp )
788 bdescr *bd, *free_bd;
790 nat size, free_blocks;
792 bd = free_bd = stp->old_blocks;
793 free = free_bd->start;
797 barf("update_bkwd: ToDo");
800 // cycle through all the blocks in the step
801 for (; bd != NULL; bd = bd->link) {
804 while (p < bd->free ) {
806 while ( p < bd->free && !is_marked(p,bd) ) {
815 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
816 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
818 while ( p < bd->free ) {
823 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
831 if (!is_marked(p+1,bd)) {
832 // don't forget to update the free ptr in the block desc.
833 free_bd->free = free;
834 free_bd = free_bd->link;
835 free = free_bd->start;
840 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
841 info = get_itbl((StgClosure *)p);
842 size = closure_sizeW_((StgClosure *)p,info);
849 if (info->type == TSO) {
850 move_TSO((StgTSO *)p, (StgTSO *)free);
861 // free the remaining blocks and count what's left.
862 free_bd->free = free;
863 if (free_bd->link != NULL) {
864 freeChain(free_bd->link);
865 free_bd->link = NULL;
872 compact( void (*get_roots)(evac_fn) )
877 // 1. thread the roots
878 get_roots((evac_fn)thread);
880 // the weak pointer lists...
881 if (weak_ptr_list != NULL) {
882 thread((StgPtr)(void *)&weak_ptr_list);
884 if (old_weak_ptr_list != NULL) {
885 thread((StgPtr)(void *)&old_weak_ptr_list); // tmp
889 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
892 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
893 for (p = bd->start; p < bd->free; p++) {
899 // the global thread list
900 thread((StgPtr)(void *)&all_threads);
902 // any threads resurrected during this GC
903 thread((StgPtr)(void *)&resurrected_threads);
908 for (task = all_tasks; task != NULL; task = task->all_link) {
910 thread((StgPtr)&task->tso);
915 // the static objects
916 thread_static(scavenged_static_objects);
918 // the stable pointer table
919 threadStablePtrTable((evac_fn)thread);
921 // the CAF list (used by GHCi)
922 markCAFs((evac_fn)thread);
924 // 2. update forward ptrs
925 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
926 for (s = 0; s < generations[g].n_steps; s++) {
927 if (g==0 && s ==0) continue;
928 stp = &generations[g].steps[s];
929 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d\n", stp->gen->no, stp->no););
931 update_fwd(stp->blocks);
932 update_fwd_large(stp->scavenged_large_objects);
933 if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
934 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
935 update_fwd_compact(stp->old_blocks);
940 // 3. update backward ptrs
941 stp = &oldest_gen->steps[0];
942 if (stp->old_blocks != NULL) {
943 blocks = update_bkwd_compact(stp);
944 IF_DEBUG(gc, debugBelch("update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n",
945 stp->gen->no, stp->no,
946 stp->n_old_blocks, blocks););
947 stp->n_old_blocks = blocks;