1 /* -----------------------------------------------------------------------*-c-*-
3 * (c) The GHC Team 1998-2006
5 * Generational garbage collector: evacuation functions
7 * ---------------------------------------------------------------------------*/
9 // We have two versions of evacuate(): one for minor GC, and one for
10 // non-minor, parallel, GC. This file contains the code for both,
11 // controllled by the CPP symbol MINOR_GC.
14 #define copy(a,b,c,d) copy0(a,b,c,d)
15 #define copy_tag(a,b,c,d,e) copy_tag0(a,b,c,d,e)
16 #define copyPart(a,b,c,d,e) copyPart0(a,b,c,d,e)
17 #define evacuate(a) evacuate0(a)
26 copy_tag(StgClosure **p, StgClosure *src, nat size, step *stp, StgWord tag)
28 StgPtr to, tagged_to, from;
32 #if !defined(MINOR_GC) && defined(THREADED_RTS)
34 info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info);
36 } while (info == (W_)&stg_WHITEHOLE_info);
37 if (info == (W_)&stg_EVACUATED_info || info == (W_)&stg_IND_info) {
38 // NB. a closure might be updated with an IND by
39 // unchain_selector_thunks(), hence the test above.
40 src->header.info = (const StgInfoTable *)info;
41 return evacuate(p); // does the failed_to_evac stuff
44 ASSERT(n_gc_threads == 1);
45 info = (W_)src->header.info;
46 src->header.info = &stg_EVACUATED_info;
49 to = alloc_for_copy(size,stp);
50 tagged_to = (StgPtr)TAG_CLOSURE(tag,(StgClosure*)to);
51 *p = (StgClosure *)tagged_to;
53 TICK_GC_WORDS_COPIED(size);
57 for (i = 1; i < size; i++) { // unroll for small i
61 // if (to+size+2 < bd->start + BLOCK_SIZE_W) {
62 // __builtin_prefetch(to + size + 2, 1);
65 ((StgEvacuated*)from)->evacuee = (StgClosure *)tagged_to;
66 #if !defined(MINOR_GC) && defined(THREADED_RTS)
68 ((StgEvacuated*)from)->header.info = &stg_EVACUATED_info;
72 // We store the size of the just evacuated object in the LDV word so that
73 // the profiler can guess the position of the next object later.
74 SET_EVACUAEE_FOR_LDV(from, size);
79 /* Special version of copy() for when we only want to copy the info
80 * pointer of an object, but reserve some padding after it. This is
81 * used to optimise evacuation of BLACKHOLEs.
84 copyPart(StgClosure **p, StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp)
90 #if !defined(MINOR_GC) && defined(THREADED_RTS)
92 info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info);
93 } while (info == (W_)&stg_WHITEHOLE_info);
94 if (info == (W_)&stg_EVACUATED_info) {
95 src->header.info = (const StgInfoTable *)info;
96 return evacuate(p); // does the failed_to_evac stuff
99 info = (W_)src->header.info;
100 src->header.info = &stg_EVACUATED_info;
103 to = alloc_for_copy(size_to_reserve, stp);
104 *p = (StgClosure *)to;
106 TICK_GC_WORDS_COPIED(size_to_copy);
110 for (i = 1; i < size_to_copy; i++) { // unroll for small i
114 ((StgEvacuated*)from)->evacuee = (StgClosure *)to;
115 #if !defined(MINOR_GC) && defined(THREADED_RTS)
117 ((StgEvacuated*)from)->header.info = &stg_EVACUATED_info;
121 // We store the size of the just evacuated object in the LDV word so that
122 // the profiler can guess the position of the next object later.
123 SET_EVACUAEE_FOR_LDV(from, size_to_reserve);
125 if (size_to_reserve - size_to_copy > 0)
126 LDV_FILL_SLOP(to + size_to_copy - 1, (int)(size_to_reserve - size_to_copy));
131 /* Copy wrappers that don't tag the closure after copying */
133 copy(StgClosure **p, StgClosure *src, nat size, step *stp)
135 copy_tag(p,src,size,stp,0);
138 /* ----------------------------------------------------------------------------
141 This is called (eventually) for every live object in the system.
143 The caller to evacuate specifies a desired generation in the
144 gct->evac_step thread-local variable. The following conditions apply to
145 evacuating an object which resides in generation M when we're
146 collecting up to generation N
148 if M >= gct->evac_step
150 else evac to step->to
152 if M < gct->evac_step evac to gct->evac_step, step 0
154 if the object is already evacuated, then we check which generation
157 if M >= gct->evac_step do nothing
158 if M < gct->evac_step set gct->failed_to_evac flag to indicate that we
159 didn't manage to evacuate this object into gct->evac_step.
164 evacuate() is the single most important function performance-wise
165 in the GC. Various things have been tried to speed it up, but as
166 far as I can tell the code generated by gcc 3.2 with -O2 is about
167 as good as it's going to get. We pass the argument to evacuate()
168 in a register using the 'regparm' attribute (see the prototype for
169 evacuate() near the top of this file).
171 Changing evacuate() to take an (StgClosure **) rather than
172 returning the new pointer seems attractive, because we can avoid
173 writing back the pointer when it hasn't changed (eg. for a static
174 object, or an object in a generation > N). However, I tried it and
175 it doesn't help. One reason is that the (StgClosure **) pointer
176 gets spilled to the stack inside evacuate(), resulting in far more
177 extra reads/writes than we save.
178 ------------------------------------------------------------------------- */
181 evacuate(StgClosure **p)
186 const StgInfoTable *info;
192 /* The tag and the pointer are split, to be merged after evacing */
193 tag = GET_CLOSURE_TAG(q);
194 q = UNTAG_CLOSURE(q);
196 ASSERT(LOOKS_LIKE_CLOSURE_PTR(q));
198 if (!HEAP_ALLOCED(q)) {
203 if (!major_gc) return;
206 switch (info->type) {
209 if (info->srt_bitmap != 0 &&
210 *THUNK_STATIC_LINK((StgClosure *)q) == NULL) {
211 ACQUIRE_SPIN_LOCK(&static_objects_sync);
212 if (*THUNK_STATIC_LINK((StgClosure *)q) == NULL) {
213 *THUNK_STATIC_LINK((StgClosure *)q) = static_objects;
214 static_objects = (StgClosure *)q;
216 RELEASE_SPIN_LOCK(&static_objects_sync);
221 if (info->srt_bitmap != 0 &&
222 *FUN_STATIC_LINK((StgClosure *)q) == NULL) {
223 ACQUIRE_SPIN_LOCK(&static_objects_sync);
224 if (*FUN_STATIC_LINK((StgClosure *)q) == NULL) {
225 *FUN_STATIC_LINK((StgClosure *)q) = static_objects;
226 static_objects = (StgClosure *)q;
228 RELEASE_SPIN_LOCK(&static_objects_sync);
233 /* If q->saved_info != NULL, then it's a revertible CAF - it'll be
234 * on the CAF list, so don't do anything with it here (we'll
235 * scavenge it later).
237 if (((StgIndStatic *)q)->saved_info == NULL) {
238 ACQUIRE_SPIN_LOCK(&static_objects_sync);
239 if (*IND_STATIC_LINK((StgClosure *)q) == NULL) {
240 *IND_STATIC_LINK((StgClosure *)q) = static_objects;
241 static_objects = (StgClosure *)q;
243 RELEASE_SPIN_LOCK(&static_objects_sync);
248 if (*STATIC_LINK(info,(StgClosure *)q) == NULL) {
249 ACQUIRE_SPIN_LOCK(&static_objects_sync);
250 // re-test, after acquiring lock
251 if (*STATIC_LINK(info,(StgClosure *)q) == NULL) {
252 *STATIC_LINK(info,(StgClosure *)q) = static_objects;
253 static_objects = (StgClosure *)q;
255 RELEASE_SPIN_LOCK(&static_objects_sync);
256 /* I am assuming that static_objects pointers are not
257 * written to other objects, and thus, no need to retag. */
261 case CONSTR_NOCAF_STATIC:
262 /* no need to put these on the static linked list, they don't need
268 barf("evacuate(static): strange closure type %d", (int)(info->type));
274 if (bd->gen_no > N) {
275 /* Can't evacuate this object, because it's in a generation
276 * older than the ones we're collecting. Let's hope that it's
277 * in gct->evac_step or older, or we will have to arrange to track
278 * this pointer using the mutable list.
280 if (bd->step < gct->evac_step) {
282 gct->failed_to_evac = rtsTrue;
283 TICK_GC_FAILED_PROMOTION();
288 if ((bd->flags & (BF_LARGE | BF_COMPACTED | BF_EVACUATED)) != 0) {
290 /* pointer into to-space: just return it. This normally
291 * shouldn't happen, but alllowing it makes certain things
292 * slightly easier (eg. the mutable list can contain the same
293 * object twice, for example).
295 if (bd->flags & BF_EVACUATED) {
296 if (bd->step < gct->evac_step) {
297 gct->failed_to_evac = rtsTrue;
298 TICK_GC_FAILED_PROMOTION();
303 /* evacuate large objects by re-linking them onto a different list.
305 if (bd->flags & BF_LARGE) {
307 if (info->type == TSO &&
308 ((StgTSO *)q)->what_next == ThreadRelocated) {
309 q = (StgClosure *)((StgTSO *)q)->link;
313 evacuate_large((P_)q);
317 /* If the object is in a step that we're compacting, then we
318 * need to use an alternative evacuate procedure.
320 if (bd->flags & BF_COMPACTED) {
321 if (!is_marked((P_)q,bd)) {
323 if (mark_stack_full()) {
324 mark_stack_overflowed = rtsTrue;
327 push_mark_stack((P_)q);
337 switch (info->type) {
346 copy(p,q,sizeW_fromITBL(info),stp);
351 StgWord w = (StgWord)q->payload[0];
352 if (q->header.info == Czh_con_info &&
353 // unsigned, so always true: (StgChar)w >= MIN_CHARLIKE &&
354 (StgChar)w <= MAX_CHARLIKE) {
355 *p = TAG_CLOSURE(tag,
356 (StgClosure *)CHARLIKE_CLOSURE((StgChar)w)
359 else if (q->header.info == Izh_con_info &&
360 (StgInt)w >= MIN_INTLIKE && (StgInt)w <= MAX_INTLIKE) {
361 *p = TAG_CLOSURE(tag,
362 (StgClosure *)INTLIKE_CLOSURE((StgInt)w)
366 copy_tag(p,q,sizeofW(StgHeader)+1,stp,tag);
374 copy_tag(p,q,sizeofW(StgHeader)+1,stp,tag);
379 copy(p,q,sizeofW(StgThunk)+1,stp);
385 #ifdef NO_PROMOTE_THUNKS
386 if (bd->gen_no == 0 &&
388 bd->step->no == generations[bd->gen_no].n_steps-1) {
392 copy(p,q,sizeofW(StgThunk)+2,stp);
400 copy_tag(p,q,sizeofW(StgHeader)+2,stp,tag);
404 copy_tag(p,q,sizeofW(StgHeader)+2,stp,tag);
408 copy(p,q,thunk_sizeW_fromITBL(info),stp);
413 case IND_OLDGEN_PERM:
417 copy_tag(p,q,sizeW_fromITBL(info),stp,tag);
421 copy(p,q,bco_sizeW((StgBCO *)q),stp);
425 case SE_CAF_BLACKHOLE:
428 copyPart(p,q,BLACKHOLE_sizeW(),sizeofW(StgHeader),stp);
432 eval_thunk_selector(p, (StgSelector *)q, rtsTrue);
437 // follow chains of indirections, don't evacuate them
438 q = ((StgInd*)q)->indirectee;
449 case CATCH_STM_FRAME:
450 case CATCH_RETRY_FRAME:
451 case ATOMICALLY_FRAME:
452 // shouldn't see these
453 barf("evacuate: stack frame at %p\n", q);
456 copy(p,q,pap_sizeW((StgPAP*)q),stp);
460 copy(p,q,ap_sizeW((StgAP*)q),stp);
464 copy(p,q,ap_stack_sizeW((StgAP_STACK*)q),stp);
468 /* Already evacuated, just return the forwarding address.
469 * HOWEVER: if the requested destination generation (gct->evac_step) is
470 * older than the actual generation (because the object was
471 * already evacuated to a younger generation) then we have to
472 * set the gct->failed_to_evac flag to indicate that we couldn't
473 * manage to promote the object to the desired generation.
476 * Optimisation: the check is fairly expensive, but we can often
477 * shortcut it if either the required generation is 0, or the
478 * current object (the EVACUATED) is in a high enough generation.
479 * We know that an EVACUATED always points to an object in the
480 * same or an older generation. stp is the lowest step that the
481 * current object would be evacuated to, so we only do the full
482 * check if stp is too low.
485 StgClosure *e = ((StgEvacuated*)q)->evacuee;
487 if (stp < gct->evac_step) { // optimisation
488 if (Bdescr((P_)e)->step < gct->evac_step) {
489 gct->failed_to_evac = rtsTrue;
490 TICK_GC_FAILED_PROMOTION();
497 // just copy the block
498 copy(p,q,arr_words_sizeW((StgArrWords *)q),stp);
501 case MUT_ARR_PTRS_CLEAN:
502 case MUT_ARR_PTRS_DIRTY:
503 case MUT_ARR_PTRS_FROZEN:
504 case MUT_ARR_PTRS_FROZEN0:
505 // just copy the block
506 copy(p,q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),stp);
511 StgTSO *tso = (StgTSO *)q;
513 /* Deal with redirected TSOs (a TSO that's had its stack enlarged).
515 if (tso->what_next == ThreadRelocated) {
516 q = (StgClosure *)tso->link;
521 /* To evacuate a small TSO, we need to relocate the update frame
528 copyPart(p,(StgClosure *)tso, tso_sizeW(tso), sizeofW(StgTSO), stp);
529 new_tso = (StgTSO *)*p;
530 move_TSO(tso, new_tso);
531 for (r = tso->sp, s = new_tso->sp;
532 r < tso->stack+tso->stack_size;) {
540 copy(p,q,sizeofW(StgTRecHeader),stp);
543 case TVAR_WATCH_QUEUE:
544 copy(p,q,sizeofW(StgTVarWatchQueue),stp);
548 copy(p,q,sizeofW(StgTVar),stp);
552 copy(p,q,sizeofW(StgTRecChunk),stp);
555 case ATOMIC_INVARIANT:
556 copy(p,q,sizeofW(StgAtomicInvariant),stp);
559 case INVARIANT_CHECK_QUEUE:
560 copy(p,q,sizeofW(StgInvariantCheckQueue),stp);
564 barf("evacuate: strange closure type %d", (int)(info->type));