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 obj_sizeW( StgClosure *p, StgInfoTable *info )
112 switch (info->type) {
115 return sizeofW(StgThunk) + 1;
120 return sizeofW(StgHeader) + 1;
124 return sizeofW(StgThunk) + 2;
131 return sizeofW(StgHeader) + 2;
133 return THUNK_SELECTOR_sizeW();
135 return ap_stack_sizeW((StgAP_STACK *)p);
138 return pap_sizeW((StgPAP *)p);
140 return arr_words_sizeW((StgArrWords *)p);
142 case MUT_ARR_PTRS_FROZEN:
143 case MUT_ARR_PTRS_FROZEN0:
144 return mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
146 return tso_sizeW((StgTSO *)p);
148 return bco_sizeW((StgBCO *)p);
149 case TVAR_WAIT_QUEUE:
150 return sizeofW(StgTVarWaitQueue);
152 return sizeofW(StgTVar);
154 return sizeofW(StgTRecChunk);
156 return sizeofW(StgTRecHeader);
158 return sizeW_fromITBL(info);
163 thread_static( StgClosure* p )
165 const StgInfoTable *info;
167 // keep going until we've threaded all the objects on the linked
169 while (p != END_OF_STATIC_LIST) {
172 switch (info->type) {
175 thread((StgPtr)&((StgInd *)p)->indirectee);
176 p = *IND_STATIC_LINK(p);
180 p = *THUNK_STATIC_LINK(p);
183 p = *FUN_STATIC_LINK(p);
186 p = *STATIC_LINK(info,p);
190 barf("thread_static: strange closure %d", (int)(info->type));
197 thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
203 bitmap = large_bitmap->bitmap[b];
204 for (i = 0; i < size; ) {
205 if ((bitmap & 1) == 0) {
210 if (i % BITS_IN(W_) == 0) {
212 bitmap = large_bitmap->bitmap[b];
214 bitmap = bitmap >> 1;
220 thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
227 switch (fun_info->f.fun_type) {
229 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
230 size = BITMAP_SIZE(fun_info->f.b.bitmap);
233 size = GET_FUN_LARGE_BITMAP(fun_info)->size;
234 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
238 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
239 size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
242 if ((bitmap & 1) == 0) {
246 bitmap = bitmap >> 1;
255 thread_stack(StgPtr p, StgPtr stack_end)
257 const StgRetInfoTable* info;
261 // highly similar to scavenge_stack, but we do pointer threading here.
263 while (p < stack_end) {
265 // *p must be the info pointer of an activation
266 // record. All activation records have 'bitmap' style layout
269 info = get_ret_itbl((StgClosure *)p);
271 switch (info->i.type) {
273 // Dynamic bitmap: the mask is stored on the stack
277 dyn = ((StgRetDyn *)p)->liveness;
279 // traverse the bitmap first
280 bitmap = RET_DYN_LIVENESS(dyn);
281 p = (P_)&((StgRetDyn *)p)->payload[0];
282 size = RET_DYN_BITMAP_SIZE;
284 if ((bitmap & 1) == 0) {
288 bitmap = bitmap >> 1;
292 // skip over the non-ptr words
293 p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
295 // follow the ptr words
296 for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
303 // small bitmap (<= 32 entries, or 64 on a 64-bit machine)
304 case CATCH_RETRY_FRAME:
305 case CATCH_STM_FRAME:
306 case ATOMICALLY_FRAME:
312 bitmap = BITMAP_BITS(info->i.layout.bitmap);
313 size = BITMAP_SIZE(info->i.layout.bitmap);
315 // NOTE: the payload starts immediately after the info-ptr, we
316 // don't have an StgHeader in the same sense as a heap closure.
318 if ((bitmap & 1) == 0) {
322 bitmap = bitmap >> 1;
335 size = BCO_BITMAP_SIZE(bco);
336 thread_large_bitmap(p, BCO_BITMAP(bco), size);
341 // large bitmap (> 32 entries, or 64 on a 64-bit machine)
345 size = GET_LARGE_BITMAP(&info->i)->size;
346 thread_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
352 StgRetFun *ret_fun = (StgRetFun *)p;
353 StgFunInfoTable *fun_info;
355 fun_info = itbl_to_fun_itbl(
356 get_threaded_info((StgPtr)ret_fun->fun));
357 // *before* threading it!
358 thread((StgPtr)&ret_fun->fun);
359 p = thread_arg_block(fun_info, ret_fun->payload);
364 barf("thread_stack: weird activation record found on stack: %d",
365 (int)(info->i.type));
371 thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
375 StgFunInfoTable *fun_info;
377 fun_info = itbl_to_fun_itbl(get_threaded_info((StgPtr)fun));
378 ASSERT(fun_info->i.type != PAP);
382 switch (fun_info->f.fun_type) {
384 bitmap = BITMAP_BITS(fun_info->f.b.bitmap);
387 thread_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
391 thread_large_bitmap((StgPtr)payload, BCO_BITMAP(fun), size);
395 bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
398 if ((bitmap & 1) == 0) {
402 bitmap = bitmap >> 1;
412 thread_PAP (StgPAP *pap)
415 p = thread_PAP_payload(pap->fun, pap->payload, pap->n_args);
416 thread((StgPtr)&pap->fun);
421 thread_AP (StgAP *ap)
424 p = thread_PAP_payload(ap->fun, ap->payload, ap->n_args);
425 thread((StgPtr)&ap->fun);
430 thread_AP_STACK (StgAP_STACK *ap)
432 thread((StgPtr)&ap->fun);
433 thread_stack((P_)ap->payload, (P_)ap->payload + ap->size);
434 return (P_)ap + sizeofW(StgAP_STACK) + ap->size;
438 thread_TSO (StgTSO *tso)
440 thread((StgPtr)&tso->link);
441 thread((StgPtr)&tso->global_link);
443 if ( tso->why_blocked == BlockedOnMVar
444 || tso->why_blocked == BlockedOnBlackHole
445 || tso->why_blocked == BlockedOnException
447 || tso->why_blocked == BlockedOnGA
448 || tso->why_blocked == BlockedOnGA_NoSend
451 thread((StgPtr)&tso->block_info.closure);
453 if ( tso->blocked_exceptions != NULL ) {
454 thread((StgPtr)&tso->blocked_exceptions);
457 thread((StgPtr)&tso->trec);
459 thread_stack(tso->sp, &(tso->stack[tso->stack_size]));
460 return (StgPtr)tso + tso_sizeW(tso);
465 update_fwd_large( bdescr *bd )
468 const StgInfoTable* info;
470 for (; bd != NULL; bd = bd->link) {
473 info = get_itbl((StgClosure *)p);
475 switch (info->type) {
482 case MUT_ARR_PTRS_FROZEN:
483 case MUT_ARR_PTRS_FROZEN0:
488 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
489 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
496 thread_TSO((StgTSO *)p);
500 thread_AP_STACK((StgAP_STACK *)p);
504 thread_PAP((StgPAP *)p);
510 StgTRecChunk *tc = (StgTRecChunk *)p;
511 TRecEntry *e = &(tc -> entries[0]);
512 thread((StgPtr)&tc->prev_chunk);
513 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
514 thread((StgPtr)&e->tvar);
515 thread((StgPtr)&e->expected_value);
516 thread((StgPtr)&e->new_value);
522 barf("update_fwd_large: unknown/strange object %d", (int)(info->type));
528 thread_obj (StgInfoTable *info, StgPtr p)
530 switch (info->type) {
532 return p + sizeofW(StgThunk) + 1;
536 return p + sizeofW(StgHeader) + 1;
540 thread((StgPtr)&((StgClosure *)p)->payload[0]);
541 return p + sizeofW(StgHeader) + 1;
544 thread((StgPtr)&((StgThunk *)p)->payload[0]);
545 return p + sizeofW(StgThunk) + 1;
548 return p + sizeofW(StgThunk) + 2;
552 return p + sizeofW(StgHeader) + 2;
555 thread((StgPtr)&((StgThunk *)p)->payload[0]);
556 return p + sizeofW(StgThunk) + 2;
560 thread((StgPtr)&((StgClosure *)p)->payload[0]);
561 return p + sizeofW(StgHeader) + 2;
564 thread((StgPtr)&((StgThunk *)p)->payload[0]);
565 thread((StgPtr)&((StgThunk *)p)->payload[1]);
566 return p + sizeofW(StgThunk) + 2;
570 thread((StgPtr)&((StgClosure *)p)->payload[0]);
571 thread((StgPtr)&((StgClosure *)p)->payload[1]);
572 return p + sizeofW(StgHeader) + 2;
575 StgBCO *bco = (StgBCO *)p;
576 thread((StgPtr)&bco->instrs);
577 thread((StgPtr)&bco->literals);
578 thread((StgPtr)&bco->ptrs);
579 thread((StgPtr)&bco->itbls);
580 return p + bco_sizeW(bco);
587 end = (P_)((StgThunk *)p)->payload +
588 info->layout.payload.ptrs;
589 for (p = (P_)((StgThunk *)p)->payload; p < end; p++) {
592 return p + info->layout.payload.nptrs;
601 case SE_CAF_BLACKHOLE:
607 end = (P_)((StgClosure *)p)->payload +
608 info->layout.payload.ptrs;
609 for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
612 return p + info->layout.payload.nptrs;
617 StgWeak *w = (StgWeak *)p;
618 thread((StgPtr)&w->key);
619 thread((StgPtr)&w->value);
620 thread((StgPtr)&w->finalizer);
621 if (w->link != NULL) {
622 thread((StgPtr)&w->link);
624 return p + sizeofW(StgWeak);
629 StgMVar *mvar = (StgMVar *)p;
630 thread((StgPtr)&mvar->head);
631 thread((StgPtr)&mvar->tail);
632 thread((StgPtr)&mvar->value);
633 return p + sizeofW(StgMVar);
637 case IND_OLDGEN_PERM:
638 thread((StgPtr)&((StgInd *)p)->indirectee);
639 return p + sizeofW(StgInd);
643 StgSelector *s = (StgSelector *)p;
644 thread((StgPtr)&s->selectee);
645 return p + THUNK_SELECTOR_sizeW();
649 return thread_AP_STACK((StgAP_STACK *)p);
652 return thread_PAP((StgPAP *)p);
655 return thread_AP((StgAP *)p);
658 return p + arr_words_sizeW((StgArrWords *)p);
661 case MUT_ARR_PTRS_FROZEN:
662 case MUT_ARR_PTRS_FROZEN0:
667 next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
668 for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
675 return thread_TSO((StgTSO *)p);
677 case TVAR_WAIT_QUEUE:
679 StgTVarWaitQueue *wq = (StgTVarWaitQueue *)p;
680 thread((StgPtr)&wq->waiting_tso);
681 thread((StgPtr)&wq->next_queue_entry);
682 thread((StgPtr)&wq->prev_queue_entry);
683 return p + sizeofW(StgTVarWaitQueue);
688 StgTVar *tvar = (StgTVar *)p;
689 thread((StgPtr)&tvar->current_value);
690 thread((StgPtr)&tvar->first_wait_queue_entry);
691 return p + sizeofW(StgTVar);
696 StgTRecHeader *trec = (StgTRecHeader *)p;
697 thread((StgPtr)&trec->enclosing_trec);
698 thread((StgPtr)&trec->current_chunk);
699 return p + sizeofW(StgTRecHeader);
705 StgTRecChunk *tc = (StgTRecChunk *)p;
706 TRecEntry *e = &(tc -> entries[0]);
707 thread((StgPtr)&tc->prev_chunk);
708 for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
709 thread((StgPtr)&e->tvar);
710 thread((StgPtr)&e->expected_value);
711 thread((StgPtr)&e->new_value);
713 return p + sizeofW(StgTRecChunk);
717 barf("update_fwd: unknown/strange object %d", (int)(info->type));
723 update_fwd( bdescr *blocks )
732 barf("update_fwd: ToDo");
735 // cycle through all the blocks in the step
736 for (; bd != NULL; bd = bd->link) {
739 // linearly scan the objects in this block
740 while (p < bd->free) {
741 ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
742 info = get_itbl((StgClosure *)p);
743 p = thread_obj(info, p);
749 update_fwd_compact( bdescr *blocks )
755 bdescr *bd, *free_bd;
761 free = free_bd->start;
764 barf("update_fwd: ToDo");
767 // cycle through all the blocks in the step
768 for (; bd != NULL; bd = bd->link) {
771 while (p < bd->free ) {
773 while ( p < bd->free && !is_marked(p,bd) ) {
782 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
783 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
785 while ( p < bd->free ) {
790 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
798 // Problem: we need to know the destination for this cell
799 // in order to unthread its info pointer. But we can't
800 // know the destination without the size, because we may
801 // spill into the next block. So we have to run down the
802 // threaded list and get the info ptr first.
803 info = get_threaded_info(p);
807 p = thread_obj(info, p);
810 if (free + size > free_bd->start + BLOCK_SIZE_W) {
811 // unset the next bit in the bitmap to indicate that
812 // this object needs to be pushed into the next
813 // block. This saves us having to run down the
814 // threaded info pointer list twice during the next pass.
816 free_bd = free_bd->link;
817 free = free_bd->start;
819 ASSERT(is_marked(q+1,bd));
832 update_bkwd_compact( step *stp )
838 bdescr *bd, *free_bd;
840 nat size, free_blocks;
842 bd = free_bd = stp->old_blocks;
843 free = free_bd->start;
847 barf("update_bkwd: ToDo");
850 // cycle through all the blocks in the step
851 for (; bd != NULL; bd = bd->link) {
854 while (p < bd->free ) {
856 while ( p < bd->free && !is_marked(p,bd) ) {
865 m = * ((StgPtr)bd->u.bitmap + ((p - bd->start) / (BITS_IN(StgWord))));
866 m >>= ((p - bd->start) & (BITS_IN(StgWord) - 1));
868 while ( p < bd->free ) {
873 if (((StgWord)p & (sizeof(W_) * BITS_IN(StgWord))) == 0) {
881 if (!is_marked(p+1,bd)) {
882 // don't forget to update the free ptr in the block desc.
883 free_bd->free = free;
884 free_bd = free_bd->link;
885 free = free_bd->start;
890 ASSERT(LOOKS_LIKE_INFO_PTR(((StgClosure *)p)->header.info));
891 info = get_itbl((StgClosure *)p);
892 size = obj_sizeW((StgClosure *)p,info);
899 if (info->type == TSO) {
900 move_TSO((StgTSO *)p, (StgTSO *)free);
911 // free the remaining blocks and count what's left.
912 free_bd->free = free;
913 if (free_bd->link != NULL) {
914 freeChain(free_bd->link);
915 free_bd->link = NULL;
922 compact( void (*get_roots)(evac_fn) )
927 // 1. thread the roots
928 get_roots((evac_fn)thread);
930 // the weak pointer lists...
931 if (weak_ptr_list != NULL) {
932 thread((StgPtr)&weak_ptr_list);
934 if (old_weak_ptr_list != NULL) {
935 thread((StgPtr)&old_weak_ptr_list); // tmp
939 for (g = 1; g < RtsFlags.GcFlags.generations; g++) {
942 for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
943 for (p = bd->start; p < bd->free; p++) {
949 // the global thread list
950 thread((StgPtr)&all_threads);
952 // any threads resurrected during this GC
953 thread((StgPtr)&resurrected_threads);
958 for (task = all_tasks; task != NULL; task = task->all_link) {
960 thread((StgPtr)&task->tso);
965 // the static objects
966 thread_static(scavenged_static_objects);
968 // the stable pointer table
969 threadStablePtrTable((evac_fn)thread);
971 // the CAF list (used by GHCi)
972 markCAFs((evac_fn)thread);
974 // 2. update forward ptrs
975 for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
976 for (s = 0; s < generations[g].n_steps; s++) {
977 if (g==0 && s ==0) continue;
978 stp = &generations[g].steps[s];
979 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d\n", stp->gen->no, stp->no););
981 update_fwd(stp->blocks);
982 update_fwd_large(stp->scavenged_large_objects);
983 if (g == RtsFlags.GcFlags.generations-1 && stp->old_blocks != NULL) {
984 IF_DEBUG(gc, debugBelch("update_fwd: %d.%d (compact)\n", stp->gen->no, stp->no););
985 update_fwd_compact(stp->old_blocks);
990 // 3. update backward ptrs
991 stp = &oldest_gen->steps[0];
992 if (stp->old_blocks != NULL) {
993 blocks = update_bkwd_compact(stp);
994 IF_DEBUG(gc, debugBelch("update_bkwd: %d.%d (compact, old: %d blocks, now %d blocks)\n",
995 stp->gen->no, stp->no,
996 stp->n_old_blocks, blocks););
997 stp->n_old_blocks = blocks;