/* -----------------------------------------------------------------------------
*
- * (c) The GHC Team 1998-2006
+ * (c) The GHC Team 1998-2008
*
* Generational garbage collector: evacuation functions
*
#include "MBlock.h"
#include "Evac.h"
#include "GC.h"
+#include "GCThread.h"
#include "GCUtils.h"
#include "Compact.h"
#include "Prelude.h"
#include "LdvProfile.h"
+#if defined(PROF_SPIN) && defined(THREADED_RTS)
+StgWord64 whitehole_spin = 0;
+#endif
+
/* Used to avoid long recursion due to selector thunks
*/
#define MAX_THUNK_SELECTOR_DEPTH 16
{
StgPtr to;
step_workspace *ws;
- bdescr *bd;
/* Find out where we're going, using the handy "to" pointer in
* the step of the source object. If it turns out we need to
}
}
- ws = &gct->steps[stp->gen_no][stp->no];
+ ws = &gct->steps[stp->abs_no];
+ // this compiles to a single mem access to stp->abs_no only
/* chain a new block onto the to-space for the destination step if
* necessary.
*/
- bd = ws->todo_bd;
- to = bd->free;
- if (to + size >= bd->start + BLOCK_SIZE_W) {
- bd = gc_alloc_todo_block(ws);
- to = bd->free;
+ to = ws->todo_free;
+ if (to + size > ws->todo_lim) {
+ to = todo_block_full(size, ws);
}
- bd->free = to + size;
+ ws->todo_free = to + size;
+ ASSERT(ws->todo_free >= ws->todo_bd->free && ws->todo_free <= ws->todo_lim);
return to;
}
-
-STATIC_INLINE void
-copy_tag(StgClosure **p, StgClosure *src, nat size, step *stp,StgWord tag)
-{
- StgPtr to, tagged_to, from;
- nat i;
- StgWord info;
-
-#ifdef THREADED_RTS
- do {
- info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info);
- // so.. what is it?
- } while (info == (W_)&stg_WHITEHOLE_info);
- if (info == (W_)&stg_EVACUATED_info) {
- src->header.info = (const StgInfoTable *)info;
- return evacuate(p); // does the failed_to_evac stuff
- }
-#else
- info = (W_)src->header.info;
- src->header.info = &stg_EVACUATED_info;
-#endif
-
- to = alloc_for_copy(size,stp);
- tagged_to = (StgPtr)TAG_CLOSURE(tag,(StgClosure*)to);
- *p = (StgClosure *)tagged_to;
-
- TICK_GC_WORDS_COPIED(size);
-
- from = (StgPtr)src;
- to[0] = info;
- for (i = 1; i < size; i++) { // unroll for small i
- to[i] = from[i];
- }
-
- ((StgEvacuated*)from)->evacuee = (StgClosure *)tagged_to;
-
- // retag pointer before updating EVACUATE closure and returning
-
-// if (to+size+2 < bd->start + BLOCK_SIZE_W) {
-// __builtin_prefetch(to + size + 2, 1);
-// }
-
-#ifdef 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
-}
-
-/* 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
- * used to optimise evacuation of BLACKHOLEs.
- */
-static void
-copyPart(StgClosure **p, StgClosure *src, nat size_to_reserve, nat size_to_copy, step *stp)
-{
- StgPtr to, from;
- nat i;
- StgWord info;
-
-#ifdef THREADED_RTS
- do {
- info = xchg((StgPtr)&src->header.info, (W_)&stg_WHITEHOLE_info);
- } while (info == (W_)&stg_WHITEHOLE_info);
- if (info == (W_)&stg_EVACUATED_info) {
- src->header.info = (const StgInfoTable *)info;
- return evacuate(p); // does the failed_to_evac stuff
- }
-#else
- info = (W_)src->header.info;
- src->header.info = &stg_EVACUATED_info;
-#endif
-
- to = alloc_for_copy(size_to_reserve, stp);
- *p = (StgClosure *)to;
-
- TICK_GC_WORDS_COPIED(size_to_copy);
-
- from = (StgPtr)src;
- to[0] = info;
- for (i = 1; i < size_to_copy; i++) { // unroll for small i
- to[i] = from[i];
- }
-
- ((StgEvacuated*)from)->evacuee = (StgClosure *)to;
-#ifdef 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_to_reserve);
- // fill the slop
- if (size_to_reserve - size_to_copy > 0)
- LDV_FILL_SLOP(to + size_to_copy - 1, (int)(size_to_reserve - size_to_copy));
-#endif
-}
-
-
-/* Copy wrappers that don't tag the closure after copying */
-STATIC_INLINE void
-copy(StgClosure **p, StgClosure *src, nat size, step *stp)
-{
- copy_tag(p,src,size,stp,0);
-}
/* -----------------------------------------------------------------------------
The evacuate() code
-------------------------------------------------------------------------- */
-#define MINOR_GC
+#define PARALLEL_GC
#include "Evac.c-inc"
-#undef MINOR_GC
+#undef PARALLEL_GC
#include "Evac.c-inc"
/* -----------------------------------------------------------------------------
evacuate_large(StgPtr p)
{
bdescr *bd = Bdescr(p);
- step *stp;
+ step *stp, *new_stp;
step_workspace *ws;
+
+ stp = bd->step;
+ ACQUIRE_SPIN_LOCK(&stp->sync_large_objects);
// object must be at the beginning of the block (or be a ByteArray)
ASSERT(get_itbl((StgClosure *)p)->type == ARR_WORDS ||
/* Don't forget to set the gct->failed_to_evac flag if we didn't get
* the desired destination (see comments in evacuate()).
*/
- if (bd->step < gct->evac_step) {
- gct->failed_to_evac = rtsTrue;
- TICK_GC_FAILED_PROMOTION();
+ if (stp < gct->evac_step) {
+ gct->failed_to_evac = rtsTrue;
+ TICK_GC_FAILED_PROMOTION();
}
+ RELEASE_SPIN_LOCK(&stp->sync_large_objects);
return;
}
- stp = bd->step;
-
- ACQUIRE_SPIN_LOCK(&stp->sync_large_objects);
// remove from large_object list
if (bd->u.back) {
bd->u.back->link = bd->link;
if (bd->link) {
bd->link->u.back = bd->u.back;
}
- RELEASE_SPIN_LOCK(&stp->sync_large_objects);
/* link it on to the evacuated large object list of the destination step
*/
- stp = bd->step->to;
- if (stp < gct->evac_step) {
+ new_stp = stp->to;
+ if (new_stp < gct->evac_step) {
if (gct->eager_promotion) {
- stp = gct->evac_step;
+ new_stp = gct->evac_step;
} else {
gct->failed_to_evac = rtsTrue;
}
}
- ws = &gct->steps[stp->gen_no][stp->no];
- bd->step = stp;
- bd->gen_no = stp->gen_no;
+ ws = &gct->steps[new_stp->abs_no];
+ bd->flags |= BF_EVACUATED;
+ bd->step = new_stp;
+ bd->gen_no = new_stp->gen_no;
bd->link = ws->todo_large_objects;
ws->todo_large_objects = bd;
- bd->flags |= BF_EVACUATED;
+
+ RELEASE_SPIN_LOCK(&stp->sync_large_objects);
}
/* -----------------------------------------------------------------------------
prev = NULL;
while (p)
{
+#ifdef THREADED_RTS
+ ASSERT(p->header.info == &stg_WHITEHOLE_info);
+#else
ASSERT(p->header.info == &stg_BLACKHOLE_info);
+#endif
+ // val must be in to-space. Not always: when we recursively
+ // invoke eval_thunk_selector(), the recursive calls will not
+ // evacuate the value (because we want to select on the value,
+ // not evacuate it), so in this case val is in from-space.
+ // ASSERT(!HEAP_ALLOCED(val) || Bdescr((P_)val)->gen_no > N || (Bdescr((P_)val)->flags & BF_EVACUATED));
+
prev = (StgSelector*)((StgClosure *)p)->payload[0];
// Update the THUNK_SELECTOR with an indirection to the
// EVACUATED closure always points to an object in the
// same or an older generation (required by the short-cut
// test in the EVACUATED case, below).
- SET_INFO(p, &stg_IND_info);
((StgInd *)p)->indirectee = val;
+ write_barrier();
+ SET_INFO(p, &stg_IND_info);
// For the purposes of LDV profiling, we have created an
// indirection.
// save any space in any case, and updating with an indirection is
// trickier in a non-collected gen: we would have to update the
// mutable list.
- if ((bd->gen_no > N) || (bd->flags & BF_EVACUATED)) {
+ if (bd->flags & BF_EVACUATED) {
unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p);
*q = (StgClosure *)p;
return;
// In threaded mode, we'll use WHITEHOLE to lock the selector
// thunk while we evaluate it.
{
- info_ptr = (StgInfoTable *)xchg((StgPtr)&p->header.info, (W_)&stg_WHITEHOLE_info);
- if (info_ptr == (W_)&stg_WHITEHOLE_info) {
- do {
- info_ptr = xchg((StgPtr)&p->header.info, (W_)&stg_WHITEHOLE_info);
- } while (info_ptr == (W_)&stg_WHITEHOLE_info);
- goto bale_out;
- }
- // make sure someone else didn't get here first
+ do {
+ info_ptr = xchg((StgPtr)&p->header.info, (W_)&stg_WHITEHOLE_info);
+ } while (info_ptr == (W_)&stg_WHITEHOLE_info);
+
+ // make sure someone else didn't get here first...
if (INFO_PTR_TO_STRUCT(info_ptr)->type != THUNK_SELECTOR) {
- goto bale_out;
+ // v. tricky now. The THUNK_SELECTOR has been evacuated
+ // by another thread, and is now either EVACUATED or IND.
+ // We need to extract ourselves from the current situation
+ // as cleanly as possible.
+ // - unlock the closure
+ // - update *q, we may have done *some* evaluation
+ // - if evac, we need to call evacuate(), because we
+ // need the write-barrier stuff.
+ // - undo the chain we've built to point to p.
+ SET_INFO(p, (const StgInfoTable *)info_ptr);
+ *q = (StgClosure *)p;
+ if (evac) evacuate(q);
+ unchain_thunk_selectors(prev_thunk_selector, (StgClosure *)p);
+ return;
}
}
#else
#ifdef PROFILING
// For the purposes of LDV profiling, we have destroyed
// the original selector thunk, p.
- SET_INFO(p, info_ptr);
+ SET_INFO(p, (StgInfoTable *)info_ptr);
LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC((StgClosure *)p);
SET_INFO(p, &stg_BLACKHOLE_info);
#endif
// We didn't manage to evaluate this thunk; restore the old info
// pointer. But don't forget: we still need to evacuate the thunk itself.
SET_INFO(p, (const StgInfoTable *)info_ptr);
+ // THREADED_RTS: we just unlocked the thunk, so another thread
+ // might get in and update it. copy() will lock it again and
+ // check whether it was updated in the meantime.
+ *q = (StgClosure *)p;
if (evac) {
- copy(&val,(StgClosure *)p,THUNK_SELECTOR_sizeW(),bd->step->to);
- } else {
- val = (StgClosure *)p;
+ copy(q,(StgClosure *)p,THUNK_SELECTOR_sizeW(),bd->step->to);
}
- *q = val;
- unchain_thunk_selectors(prev_thunk_selector, val);
+ unchain_thunk_selectors(prev_thunk_selector, *q);
return;
}
projects / ghc-hetmet.git / blobdiff