/* -----------------------------------------------------------------------*-c-*-
*
- * (c) The GHC Team 1998-2006
+ * (c) The GHC Team 1998-2008
*
* Generational garbage collector: evacuation functions
*
// non-minor, parallel, GC. This file contains the code for both,
// controllled by the CPP symbol MINOR_GC.
-#ifdef MINOR_GC
-#define copy(a,b,c,d) copy0(a,b,c,d)
-#define copy_tag(a,b,c,d,e) copy_tag0(a,b,c,d,e)
-#define copyPart(a,b,c,d,e) copyPart0(a,b,c,d,e)
-#define evacuate(a) evacuate0(a)
+#if defined(THREADED_RTS)
+# if !defined(PARALLEL_GC)
+# define copy(a,b,c,d,e) copy1(a,b,c,d,e)
+# define copy_tag(a,b,c,d,e,f) copy_tag1(a,b,c,d,e,f)
+# define copy_tag_nolock(a,b,c,d,e,f) copy_tag1(a,b,c,d,e,f)
+# define copyPart(a,b,c,d,e) copyPart1(a,b,c,d,e)
+# define evacuate(a) evacuate1(a)
+# endif
#else
-#undef copy
-#undef copy_tag
-#undef copyPart
-#undef evacuate
+# define copy_tag_nolock(a,b,c,d,e,f) copy_tag(a,b,c,d,e,f)
#endif
STATIC_INLINE void
-copy_tag(StgClosure **p, StgClosure *src, nat size, step *stp, StgWord tag)
+copy_tag(StgClosure **p, const StgInfoTable *info,
+ StgClosure *src, nat size, step *stp, StgWord tag)
{
- StgPtr to, tagged_to, from;
+ StgPtr to, from;
nat i;
- StgWord info;
-#if !defined(MINOR_GC) && defined(THREADED_RTS)
-spin:
- info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info);
- // so.. what is it?
- if (info == (W_)&stg_WHITEHOLE_info) {
-#ifdef PROF_SPIN
- whitehole_spin++;
-#endif
- goto spin;
+ to = alloc_for_copy(size,stp);
+
+ TICK_GC_WORDS_COPIED(size);
+
+ from = (StgPtr)src;
+ to[0] = (W_)info;
+ for (i = 1; i < size; i++) { // unroll for small i
+ to[i] = from[i];
}
- if (info == (W_)&stg_EVACUATED_info || info == (W_)&stg_IND_info) {
- // NB. a closure might be updated with an IND by
- // unchain_selector_thunks(), hence the test above.
- src->header.info = (const StgInfoTable *)info;
- return evacuate(p); // does the failed_to_evac stuff
+
+// if (to+size+2 < bd->start + BLOCK_SIZE_W) {
+// __builtin_prefetch(to + size + 2, 1);
+// }
+
+#if defined(PARALLEL_GC)
+ {
+ const StgInfoTable *new_info;
+ new_info = (const StgInfoTable *)cas((StgPtr)&src->header.info, (W_)info, MK_FORWARDING_PTR(to));
+ if (new_info != info) {
+ return evacuate(p); // does the failed_to_evac stuff
+ } else {
+ *p = TAG_CLOSURE(tag,(StgClosure*)to);
+ }
}
#else
- ASSERT(n_gc_threads == 1);
- info = (W_)src->header.info;
- src->header.info = &stg_EVACUATED_info;
+ src->header.info = (const StgInfoTable *)MK_FORWARDING_PTR(to);
+ *p = TAG_CLOSURE(tag,(StgClosure*)to);
#endif
+#ifdef PROFILING
+ // We store the size of the just evacuated object in the LDV word so that
+ // the profiler can guess the position of the next object later.
+ SET_EVACUAEE_FOR_LDV(from, size);
+#endif
+}
+
+#if defined(PARALLEL_GC)
+STATIC_INLINE void
+copy_tag_nolock(StgClosure **p, const StgInfoTable *info,
+ StgClosure *src, nat size, step *stp, StgWord tag)
+{
+ StgPtr to, from;
+ nat i;
+
to = alloc_for_copy(size,stp);
- tagged_to = (StgPtr)TAG_CLOSURE(tag,(StgClosure*)to);
- *p = (StgClosure *)tagged_to;
+ *p = TAG_CLOSURE(tag,(StgClosure*)to);
+ src->header.info = (const StgInfoTable *)MK_FORWARDING_PTR(to);
TICK_GC_WORDS_COPIED(size);
from = (StgPtr)src;
- to[0] = info;
+ to[0] = (W_)info;
for (i = 1; i < size; i++) { // unroll for small i
to[i] = from[i];
}
// __builtin_prefetch(to + size + 2, 1);
// }
- ((StgEvacuated*)from)->evacuee = (StgClosure *)tagged_to;
-#if !defined(MINOR_GC) && defined(THREADED_RTS)
- write_barrier();
- ((StgEvacuated*)from)->header.info = &stg_EVACUATED_info;
-#endif
-
#ifdef PROFILING
// We store the size of the just evacuated object in the LDV word so that
// the profiler can guess the position of the next object later.
SET_EVACUAEE_FOR_LDV(from, size);
#endif
}
-
+#endif
/* Special version of copy() for when we only want to copy the info
* pointer of an object, but reserve some padding after it. This is
nat i;
StgWord info;
-#if !defined(MINOR_GC) && defined(THREADED_RTS)
+#if defined(PARALLEL_GC)
spin:
info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info);
if (info == (W_)&stg_WHITEHOLE_info) {
#endif
goto spin;
}
- if (info == (W_)&stg_EVACUATED_info) {
+ if (IS_FORWARDING_PTR(info)) {
src->header.info = (const StgInfoTable *)info;
evacuate(p); // does the failed_to_evac stuff
return ;
}
#else
info = (W_)src->header.info;
- src->header.info = &stg_EVACUATED_info;
#endif
to = alloc_for_copy(size_to_reserve, stp);
to[i] = from[i];
}
- ((StgEvacuated*)from)->evacuee = (StgClosure *)to;
-#if !defined(MINOR_GC) && defined(THREADED_RTS)
+#if defined(PARALLEL_GC)
write_barrier();
- ((StgEvacuated*)from)->header.info = &stg_EVACUATED_info;
#endif
+ src->header.info = (const StgInfoTable*)MK_FORWARDING_PTR(to);
#ifdef PROFILING
// We store the size of the just evacuated object in the LDV word so that
/* Copy wrappers that don't tag the closure after copying */
STATIC_INLINE void
-copy(StgClosure **p, StgClosure *src, nat size, step *stp)
+copy(StgClosure **p, const StgInfoTable *info,
+ StgClosure *src, nat size, step *stp)
{
- copy_tag(p,src,size,stp,0);
+ copy_tag(p,info,src,size,stp,0);
}
/* ----------------------------------------------------------------------------
if (!HEAP_ALLOCED(q)) {
-#ifdef MINOR_GC
- return;
-#endif
if (!major_gc) return;
info = get_itbl(q);
bd = Bdescr((P_)q);
- if (bd->gen_no > N) {
- /* Can't evacuate this object, because it's in a generation
- * older than the ones we're collecting. Let's hope that it's
- * in gct->evac_step or older, or we will have to arrange to track
- * this pointer using the mutable list.
- */
- if (bd->step < gct->evac_step) {
- // nope
- gct->failed_to_evac = rtsTrue;
- TICK_GC_FAILED_PROMOTION();
- }
- return;
- }
-
if ((bd->flags & (BF_LARGE | BF_COMPACTED | BF_EVACUATED)) != 0) {
- /* pointer into to-space: just return it. This normally
- * shouldn't happen, but alllowing it makes certain things
- * slightly easier (eg. the mutable list can contain the same
- * object twice, for example).
- */
+ // pointer into to-space: just return it. It might be a pointer
+ // into a generation that we aren't collecting (> N), or it
+ // might just be a pointer into to-space. The latter doesn't
+ // happen often, but allowing it makes certain things a bit
+ // easier; e.g. scavenging an object is idempotent, so it's OK to
+ // have an object on the mutable list multiple times.
if (bd->flags & BF_EVACUATED) {
+ // We aren't copying this object, so we have to check
+ // whether it is already in the target generation. (this is
+ // the write barrier).
if (bd->step < gct->evac_step) {
gct->failed_to_evac = rtsTrue;
TICK_GC_FAILED_PROMOTION();
info = get_itbl(q);
if (info->type == TSO &&
((StgTSO *)q)->what_next == ThreadRelocated) {
- q = (StgClosure *)((StgTSO *)q)->link;
+ q = (StgClosure *)((StgTSO *)q)->_link;
*p = q;
goto loop;
}
stp = bd->step->to;
- info = get_itbl(q);
-
- switch (info->type) {
+ info = q->header.info;
+ if (IS_FORWARDING_PTR(info))
+ {
+ /* Already evacuated, just return the forwarding address.
+ * HOWEVER: if the requested destination generation (gct->evac_step) is
+ * older than the actual generation (because the object was
+ * already evacuated to a younger generation) then we have to
+ * set the gct->failed_to_evac flag to indicate that we couldn't
+ * manage to promote the object to the desired generation.
+ */
+ /*
+ * Optimisation: the check is fairly expensive, but we can often
+ * shortcut it if either the required generation is 0, or the
+ * current object (the EVACUATED) is in a high enough generation.
+ * We know that an EVACUATED always points to an object in the
+ * same or an older generation. stp is the lowest step that the
+ * current object would be evacuated to, so we only do the full
+ * check if stp is too low.
+ */
+ StgClosure *e = (StgClosure*)UN_FORWARDING_PTR(info);
+ *p = TAG_CLOSURE(tag,e);
+ if (stp < gct->evac_step) { // optimisation
+ if (Bdescr((P_)e)->step < gct->evac_step) {
+ gct->failed_to_evac = rtsTrue;
+ TICK_GC_FAILED_PROMOTION();
+ }
+ }
+ return;
+ }
+
+ switch (INFO_PTR_TO_STRUCT(info)->type) {
case WHITEHOLE:
goto loop;
case MUT_VAR_DIRTY:
case MVAR_CLEAN:
case MVAR_DIRTY:
- copy(p,q,sizeW_fromITBL(info),stp);
+ copy(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp);
return;
case CONSTR_0_1:
{
StgWord w = (StgWord)q->payload[0];
- if (q->header.info == Czh_con_info &&
+ if (info == Czh_con_info &&
// unsigned, so always true: (StgChar)w >= MIN_CHARLIKE &&
(StgChar)w <= MAX_CHARLIKE) {
*p = TAG_CLOSURE(tag,
(StgClosure *)CHARLIKE_CLOSURE((StgChar)w)
);
}
- else if (q->header.info == Izh_con_info &&
+ else if (info == Izh_con_info &&
(StgInt)w >= MIN_INTLIKE && (StgInt)w <= MAX_INTLIKE) {
*p = TAG_CLOSURE(tag,
(StgClosure *)INTLIKE_CLOSURE((StgInt)w)
);
}
else {
- copy_tag(p,q,sizeofW(StgHeader)+1,stp,tag);
+ copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag);
}
return;
}
case FUN_0_1:
case FUN_1_0:
case CONSTR_1_0:
- copy_tag(p,q,sizeofW(StgHeader)+1,stp,tag);
+ copy_tag_nolock(p,info,q,sizeofW(StgHeader)+1,stp,tag);
return;
case THUNK_1_0:
case THUNK_0_1:
- copy(p,q,sizeofW(StgThunk)+1,stp);
+ copy(p,info,q,sizeofW(StgThunk)+1,stp);
return;
case THUNK_1_1:
stp = bd->step;
}
#endif
- copy(p,q,sizeofW(StgThunk)+2,stp);
+ copy(p,info,q,sizeofW(StgThunk)+2,stp);
return;
case FUN_1_1:
case FUN_0_2:
case CONSTR_1_1:
case CONSTR_2_0:
- copy_tag(p,q,sizeofW(StgHeader)+2,stp,tag);
+ copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,stp,tag);
return;
case CONSTR_0_2:
- copy_tag(p,q,sizeofW(StgHeader)+2,stp,tag);
+ copy_tag_nolock(p,info,q,sizeofW(StgHeader)+2,stp,tag);
return;
case THUNK:
- copy(p,q,thunk_sizeW_fromITBL(info),stp);
+ copy(p,info,q,thunk_sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp);
return;
case FUN:
case IND_PERM:
case IND_OLDGEN_PERM:
+ case CONSTR:
+ copy_tag_nolock(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp,tag);
+ return;
+
case WEAK:
case STABLE_NAME:
- case CONSTR:
- copy_tag(p,q,sizeW_fromITBL(info),stp,tag);
+ copy_tag(p,info,q,sizeW_fromITBL(INFO_PTR_TO_STRUCT(info)),stp,tag);
return;
case BCO:
- copy(p,q,bco_sizeW((StgBCO *)q),stp);
+ copy(p,info,q,bco_sizeW((StgBCO *)q),stp);
return;
case CAF_BLACKHOLE:
barf("evacuate: stack frame at %p\n", q);
case PAP:
- copy(p,q,pap_sizeW((StgPAP*)q),stp);
+ copy(p,info,q,pap_sizeW((StgPAP*)q),stp);
return;
case AP:
- copy(p,q,ap_sizeW((StgAP*)q),stp);
+ copy(p,info,q,ap_sizeW((StgAP*)q),stp);
return;
case AP_STACK:
- copy(p,q,ap_stack_sizeW((StgAP_STACK*)q),stp);
+ copy(p,info,q,ap_stack_sizeW((StgAP_STACK*)q),stp);
return;
- case EVACUATED:
- /* Already evacuated, just return the forwarding address.
- * HOWEVER: if the requested destination generation (gct->evac_step) is
- * older than the actual generation (because the object was
- * already evacuated to a younger generation) then we have to
- * set the gct->failed_to_evac flag to indicate that we couldn't
- * manage to promote the object to the desired generation.
- */
- /*
- * Optimisation: the check is fairly expensive, but we can often
- * shortcut it if either the required generation is 0, or the
- * current object (the EVACUATED) is in a high enough generation.
- * We know that an EVACUATED always points to an object in the
- * same or an older generation. stp is the lowest step that the
- * current object would be evacuated to, so we only do the full
- * check if stp is too low.
- */
- {
- StgClosure *e = ((StgEvacuated*)q)->evacuee;
- *p = e;
- if (stp < gct->evac_step) { // optimisation
- if (Bdescr((P_)e)->step < gct->evac_step) {
- gct->failed_to_evac = rtsTrue;
- TICK_GC_FAILED_PROMOTION();
- }
- }
- return;
- }
-
case ARR_WORDS:
// just copy the block
- copy(p,q,arr_words_sizeW((StgArrWords *)q),stp);
+ copy(p,info,q,arr_words_sizeW((StgArrWords *)q),stp);
return;
case MUT_ARR_PTRS_CLEAN:
case MUT_ARR_PTRS_FROZEN:
case MUT_ARR_PTRS_FROZEN0:
// just copy the block
- copy(p,q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),stp);
+ copy(p,info,q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),stp);
return;
case TSO:
/* Deal with redirected TSOs (a TSO that's had its stack enlarged).
*/
if (tso->what_next == ThreadRelocated) {
- q = (StgClosure *)tso->link;
+ q = (StgClosure *)tso->_link;
*p = q;
goto loop;
}
}
case TREC_HEADER:
- copy(p,q,sizeofW(StgTRecHeader),stp);
+ copy(p,info,q,sizeofW(StgTRecHeader),stp);
return;
case TVAR_WATCH_QUEUE:
- copy(p,q,sizeofW(StgTVarWatchQueue),stp);
+ copy(p,info,q,sizeofW(StgTVarWatchQueue),stp);
return;
case TVAR:
- copy(p,q,sizeofW(StgTVar),stp);
+ copy(p,info,q,sizeofW(StgTVar),stp);
return;
case TREC_CHUNK:
- copy(p,q,sizeofW(StgTRecChunk),stp);
+ copy(p,info,q,sizeofW(StgTRecChunk),stp);
return;
case ATOMIC_INVARIANT:
- copy(p,q,sizeofW(StgAtomicInvariant),stp);
+ copy(p,info,q,sizeofW(StgAtomicInvariant),stp);
return;
case INVARIANT_CHECK_QUEUE:
- copy(p,q,sizeofW(StgInvariantCheckQueue),stp);
+ copy(p,info,q,sizeofW(StgInvariantCheckQueue),stp);
return;
default:
- barf("evacuate: strange closure type %d", (int)(info->type));
+ barf("evacuate: strange closure type %d", (int)(INFO_PTR_TO_STRUCT(info)->type));
}
barf("evacuate");
#undef copy
#undef copy_tag
+#undef copy_tag_nolock
#undef copyPart
#undef evacuate
projects / ghc-hetmet.git / blobdiff