/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.157 2003/06/26 20:47:47 panne Exp $
*
* (c) The GHC Team 1998-2003
*
#include "RtsUtils.h"
#include "Apply.h"
#include "Storage.h"
-#include "StoragePriv.h"
+#include "LdvProfile.h"
+#include "Updates.h"
#include "Stats.h"
#include "Schedule.h"
-#include "SchedAPI.h" // for ReverCAFs prototype
#include "Sanity.h"
#include "BlockAlloc.h"
#include "MBlock.h"
#include "ProfHeap.h"
#include "SchedAPI.h"
#include "Weak.h"
-#include "StablePriv.h"
#include "Prelude.h"
#include "ParTicky.h" // ToDo: move into Rts.h
#include "GCCompact.h"
#include "Signals.h"
+#include "STM.h"
#if defined(GRAN) || defined(PAR)
# include "GranSimRts.h"
# include "ParallelRts.h"
#endif
#include "RetainerProfile.h"
-#include "LdvProfile.h"
#include <string.h>
// Use a register argument for evacuate, if available.
#if __GNUC__ >= 2
-static StgClosure * evacuate (StgClosure *q) __attribute__((regparm(1)));
+#define REGPARM1 __attribute__((regparm(1)))
#else
-static StgClosure * evacuate (StgClosure *q);
+#define REGPARM1
#endif
+REGPARM1 static StgClosure * evacuate (StgClosure *q);
+
static void zero_static_object_list ( StgClosure* first_static );
-static void zero_mutable_list ( StgMutClosure *first );
static rtsBool traverse_weak_ptr_list ( void );
static void mark_weak_ptr_list ( StgWeak **list );
static void scavenge_large ( step * );
static void scavenge_static ( void );
static void scavenge_mutable_list ( generation *g );
-static void scavenge_mut_once_list ( generation *g );
static void scavenge_large_bitmap ( StgPtr p,
StgLargeBitmap *large_bitmap,
static bdescr *oldgen_scan_bd;
static StgPtr oldgen_scan;
-static inline rtsBool
+STATIC_INLINE rtsBool
mark_stack_empty(void)
{
return mark_sp == mark_stack;
}
-static inline rtsBool
+STATIC_INLINE rtsBool
mark_stack_full(void)
{
return mark_sp >= mark_splim;
}
-static inline void
+STATIC_INLINE void
reset_mark_stack(void)
{
mark_sp = mark_stack;
}
-static inline void
+STATIC_INLINE void
push_mark_stack(StgPtr p)
{
*mark_sp++ = p;
}
-static inline StgPtr
+STATIC_INLINE StgPtr
pop_mark_stack(void)
{
return *--mark_sp;
(and all younger generations):
- follow all pointers in the root set. the root set includes all
- mutable objects in all generations (mutable_list and mut_once_list).
+ mutable objects in all generations (mutable_list).
- for each pointer, evacuate the object it points to into either
When we evacuate an object we attempt to evacuate
everything it points to into the same generation - this is
achieved by setting evac_gen to the desired generation. If
- we can't do this, then an entry in the mut_once list has to
+ we can't do this, then an entry in the mut list has to
be made for the cross-generation pointer.
+ if the object is already in a generation > N, then leave
#endif
#if defined(DEBUG) && defined(GRAN)
- IF_DEBUG(gc, belch("@@ Starting garbage collection at %ld (%lx)\n",
+ IF_DEBUG(gc, debugBelch("@@ Starting garbage collection at %ld (%lx)\n",
Now, Now));
#endif
blockUserSignals();
#endif
+ // tell the STM to discard any cached closures its hoping to re-use
+ stmPreGCHook();
+
// tell the stats department that we've started a GC
stat_startGC();
static_objects = END_OF_STATIC_LIST;
scavenged_static_objects = END_OF_STATIC_LIST;
- /* zero the mutable list for the oldest generation (see comment by
- * zero_mutable_list below).
- */
- if (major_gc) {
- zero_mutable_list(generations[RtsFlags.GcFlags.generations-1].mut_once_list);
- }
-
/* Save the old to-space if we're doing a two-space collection
*/
if (RtsFlags.GcFlags.generations == 1) {
old_to_blocks = g0s0->to_blocks;
g0s0->to_blocks = NULL;
+ g0s0->n_to_blocks = 0;
}
/* Keep a count of how many new blocks we allocated during this GC
// collecting.
//
for (g = 0; g <= N; g++) {
- generations[g].mut_once_list = END_MUT_LIST;
- generations[g].mut_list = END_MUT_LIST;
+
+ // throw away the mutable list. Invariant: the mutable list
+ // always has at least one block; this means we can avoid a check for
+ // NULL in recordMutable().
+ if (g != 0) {
+ freeChain(generations[g].mut_list);
+ generations[g].mut_list = allocBlock();
+ }
for (s = 0; s < generations[g].n_steps; s++) {
// mark the large objects as not evacuated yet
for (bd = stp->large_objects; bd; bd = bd->link) {
- bd->flags = BF_LARGE;
+ bd->flags &= ~BF_EVACUATED;
}
// for a compacted step, we need to allocate the bitmap
stp->bitmap = bitmap_bdescr;
bitmap = bitmap_bdescr->start;
- IF_DEBUG(gc, belch("bitmap_size: %d, bitmap: %p",
+ IF_DEBUG(gc, debugBelch("bitmap_size: %d, bitmap: %p",
bitmap_size, bitmap););
// don't forget to fill it with zeros!
memset(bitmap, 0, bitmap_size);
- // for each block in this step, point to its bitmap from the
+ // For each block in this step, point to its bitmap from the
// block descriptor.
for (bd=stp->blocks; bd != NULL; bd = bd->link) {
bd->u.bitmap = bitmap;
bitmap += BLOCK_SIZE_W / (sizeof(W_)*BITS_PER_BYTE);
+
+ // Also at this point we set the BF_COMPACTED flag
+ // for this block. The invariant is that
+ // BF_COMPACTED is always unset, except during GC
+ // when it is set on those blocks which will be
+ // compacted.
+ bd->flags |= BF_COMPACTED;
}
}
}
int st;
for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
generations[g].saved_mut_list = generations[g].mut_list;
- generations[g].mut_list = END_MUT_LIST;
- }
-
- // Do the mut-once lists first
- for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
- IF_PAR_DEBUG(verbose,
- printMutOnceList(&generations[g]));
- scavenge_mut_once_list(&generations[g]);
- evac_gen = g;
- for (st = generations[g].n_steps-1; st >= 0; st--) {
- scavenge(&generations[g].steps[st]);
- }
+ generations[g].mut_list = allocBlock();
+ // mut_list always has at least one block.
}
for (g = RtsFlags.GcFlags.generations-1; g > N; g--) {
- IF_PAR_DEBUG(verbose,
- printMutableList(&generations[g]));
+ IF_PAR_DEBUG(verbose, printMutableList(&generations[g]));
scavenge_mutable_list(&generations[g]);
evac_gen = g;
for (st = generations[g].n_steps-1; st >= 0; st--) {
*/
markStablePtrTable(mark_root);
-#ifdef INTERPRETER
- {
- /* ToDo: To fix the caf leak, we need to make the commented out
- * parts of this code do something sensible - as described in
- * the CAF document.
- */
- extern void markHugsObjects(void);
- markHugsObjects();
- }
-#endif
-
/* -------------------------------------------------------------------------
* Repeatedly scavenge all the areas we know about until there's no
* more scavenging to be done.
generations[g].collections++; // for stats
}
+ // Count the mutable list as bytes "copied" for the purposes of
+ // stats. Every mutable list is copied during every GC.
+ if (g > 0) {
+ for (bd = generations[g].mut_list; bd != NULL; bd = bd->link) {
+ copied += (bd->free - bd->start) * sizeof(StgWord);
+ }
+ }
+
for (s = 0; s < generations[g].n_steps; s++) {
bdescr *next;
stp = &generations[g].steps[s];
// for a compacted step, just shift the new to-space
// onto the front of the now-compacted existing blocks.
for (bd = stp->to_blocks; bd != NULL; bd = bd->link) {
- bd->flags &= ~BF_EVACUATED; // now from-space
+ bd->flags &= ~BF_EVACUATED; // now from-space
}
// tack the new blocks on the end of the existing blocks
if (stp->blocks == NULL) {
if (next == NULL) {
bd->link = stp->to_blocks;
}
+ // NB. this step might not be compacted next
+ // time, so reset the BF_COMPACTED flags.
+ // They are set before GC if we're going to
+ // compact. (search for BF_COMPACTED above).
+ bd->flags &= ~BF_COMPACTED;
}
}
// add the new blocks to the block tally
stp->blocks = stp->to_blocks;
stp->n_blocks = stp->n_to_blocks;
for (bd = stp->blocks; bd != NULL; bd = bd->link) {
- bd->flags &= ~BF_EVACUATED; // now from-space
+ bd->flags &= ~BF_EVACUATED; // now from-space
}
}
stp->to_blocks = NULL;
oldest_gen->steps[0].n_blocks >
(RtsFlags.GcFlags.compactThreshold * max) / 100))) {
oldest_gen->steps[0].is_compacted = 1;
-// fprintf(stderr,"compaction: on\n", live);
+// debugBelch("compaction: on\n", live);
} else {
oldest_gen->steps[0].is_compacted = 0;
-// fprintf(stderr,"compaction: off\n", live);
+// debugBelch("compaction: off\n", live);
}
// if we're going to go over the maximum heap size, reduce the
}
#if 0
- fprintf(stderr,"live: %d, min_alloc: %d, size : %d, max = %d\n", live,
+ debugBelch("live: %d, min_alloc: %d, size : %d, max = %d\n", live,
min_alloc, size, max);
#endif
int pc_free;
adjusted_blocks = (RtsFlags.GcFlags.maxHeapSize - 2 * blocks);
- IF_DEBUG(gc, belch("@@ Near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks));
+ IF_DEBUG(gc, debugBelch("@@ Near maximum heap size of 0x%x blocks, blocks = %d, adjusted to %ld", RtsFlags.GcFlags.maxHeapSize, blocks, adjusted_blocks));
pc_free = adjusted_blocks * 100 / RtsFlags.GcFlags.maxHeapSize;
if (pc_free < RtsFlags.GcFlags.pcFreeHeap) /* might even be < 0 */ {
heapOverflow();
w->link = weak_ptr_list;
weak_ptr_list = w;
flag = rtsTrue;
- IF_DEBUG(weak, belch("Weak pointer still alive at %p -> %p",
+ IF_DEBUG(weak, debugBelch("Weak pointer still alive at %p -> %p",
w, w->key));
continue;
}
prev = &old_all_threads;
for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
- (StgClosure *)tmp = isAlive((StgClosure *)t);
+ tmp = (StgTSO *)isAlive((StgClosure *)t);
if (tmp != NULL) {
t = tmp;
StgTSO *t, *tmp, *next;
for (t = old_all_threads; t != END_TSO_QUEUE; t = next) {
next = t->global_link;
- (StgClosure *)tmp = evacuate((StgClosure *)t);
+ tmp = (StgTSO *)evacuate((StgClosure *)t);
tmp->global_link = resurrected_threads;
resurrected_threads = tmp;
}
default:
barf("traverse_weak_ptr_list");
+ return rtsTrue;
}
}
// w might be WEAK, EVACUATED, or DEAD_WEAK (actually CON_STATIC) here
ASSERT(w->header.info == &stg_DEAD_WEAK_info
|| get_itbl(w)->type == WEAK || get_itbl(w)->type == EVACUATED);
- (StgClosure *)w = evacuate((StgClosure *)w);
+ w = (StgWeak *)evacuate((StgClosure *)w);
*last_w = w;
last_w = &(w->link);
}
}
// check the mark bit for compacted steps
- if (bd->step->is_compacted && is_marked((P_)p,bd)) {
+ if ((bd->flags & BF_COMPACTED) && is_marked((P_)p,bd)) {
return p;
}
*root = evacuate(*root);
}
-static __inline__ void
+STATIC_INLINE void
upd_evacuee(StgClosure *p, StgClosure *dest)
{
- // Source object must be in from-space:
- ASSERT((Bdescr((P_)p)->flags & BF_EVACUATED) == 0);
// not true: (ToDo: perhaps it should be)
// ASSERT(Bdescr((P_)dest)->flags & BF_EVACUATED);
- p->header.info = &stg_EVACUATED_info;
+ SET_INFO(p, &stg_EVACUATED_info);
((StgEvacuated *)p)->evacuee = dest;
}
-static __inline__ StgClosure *
+STATIC_INLINE StgClosure *
copy(StgClosure *src, nat size, step *stp)
{
P_ to, from, dest;
-------------------------------------------------------------------------- */
-static inline void
+STATIC_INLINE void
evacuate_large(StgPtr p)
{
bdescr *bd = Bdescr(p);
}
/* -----------------------------------------------------------------------------
- Adding a MUT_CONS to an older generation.
-
- This is necessary from time to time when we end up with an
- old-to-new generation pointer in a non-mutable object. We defer
- the promotion until the next GC.
- -------------------------------------------------------------------------- */
-
-static StgClosure *
-mkMutCons(StgClosure *ptr, generation *gen)
-{
- StgMutVar *q;
- step *stp;
-
- stp = &gen->steps[0];
-
- /* chain a new block onto the to-space for the destination step if
- * necessary.
- */
- if (stp->hp + sizeofW(StgIndOldGen) >= stp->hpLim) {
- gc_alloc_block(stp);
- }
-
- q = (StgMutVar *)stp->hp;
- stp->hp += sizeofW(StgMutVar);
-
- SET_HDR(q,&stg_MUT_CONS_info,CCS_GC);
- q->var = ptr;
- recordOldToNewPtrs((StgMutClosure *)q);
-
- return (StgClosure *)q;
-}
-
-/* -----------------------------------------------------------------------------
Evacuate
This is called (eventually) for every live object in the system.
extra reads/writes than we save.
-------------------------------------------------------------------------- */
-static StgClosure *
+REGPARM1 static StgClosure *
evacuate(StgClosure *q)
{
StgClosure *to;
/* If the object is in a step that we're compacting, then we
* need to use an alternative evacuate procedure.
*/
- if (bd->step->is_compacted) {
+ if (bd->flags & BF_COMPACTED) {
if (!is_marked((P_)q,bd)) {
mark((P_)q,bd);
if (mark_stack_full()) {
return q;
}
+ /* Object is not already evacuated. */
+ ASSERT((bd->flags & BF_EVACUATED) == 0);
+
stp = bd->step->to;
}
#ifdef DEBUG
case FUN_1_0:
case FUN_0_1:
case CONSTR_1_0:
+ case THUNK_1_0:
+ case THUNK_0_1:
return copy(q,sizeofW(StgHeader)+1,stp);
- case THUNK_1_0: // here because of MIN_UPD_SIZE
- case THUNK_0_1:
case THUNK_1_1:
case THUNK_0_2:
case THUNK_2_0:
case UPDATE_FRAME:
case STOP_FRAME:
case CATCH_FRAME:
+ case CATCH_STM_FRAME:
+ case CATCH_RETRY_FRAME:
+ case ATOMICALLY_FRAME:
// shouldn't see these
barf("evacuate: stack frame at %p\n", q);
case MUT_ARR_PTRS:
case MUT_ARR_PTRS_FROZEN:
+ case MUT_ARR_PTRS_FROZEN0:
// just copy the block
return copy(q,mut_arr_ptrs_sizeW((StgMutArrPtrs *)q),stp);
//ToDo: derive size etc from reverted IP
//to = copy(q,size,stp);
IF_DEBUG(gc,
- belch("@@ evacuate: RBH %p (%s) to %p (%s)",
+ debugBelch("@@ evacuate: RBH %p (%s) to %p (%s)",
q, info_type(q), to, info_type(to)));
return to;
}
ASSERT(sizeofW(StgBlockedFetch) >= MIN_NONUPD_SIZE);
to = copy(q,sizeofW(StgBlockedFetch),stp);
IF_DEBUG(gc,
- belch("@@ evacuate: %p (%s) to %p (%s)",
+ debugBelch("@@ evacuate: %p (%s) to %p (%s)",
q, info_type(q), to, info_type(to)));
return to;
ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE);
to = copy(q,sizeofW(StgFetchMe),stp);
IF_DEBUG(gc,
- belch("@@ evacuate: %p (%s) to %p (%s)",
+ debugBelch("@@ evacuate: %p (%s) to %p (%s)",
q, info_type(q), to, info_type(to)));
return to;
ASSERT(sizeofW(StgBlockedFetch) >= MIN_UPD_SIZE);
to = copy(q,sizeofW(StgFetchMeBlockingQueue),stp);
IF_DEBUG(gc,
- belch("@@ evacuate: %p (%s) to %p (%s)",
+ debugBelch("@@ evacuate: %p (%s) to %p (%s)",
q, info_type(q), to, info_type(to)));
return to;
#endif
+ case TREC_HEADER:
+ return copy(q,sizeofW(StgTRecHeader),stp);
+
+ case TVAR_WAIT_QUEUE:
+ return copy(q,sizeofW(StgTVarWaitQueue),stp);
+
+ case TVAR:
+ return copy(q,sizeofW(StgTVar),stp);
+
+ case TREC_CHUNK:
+ return copy(q,sizeofW(StgTRecChunk),stp);
+
default:
barf("evacuate: strange closure type %d", (int)(info->type));
}
thunk is unchanged.
-------------------------------------------------------------------------- */
+static inline rtsBool
+is_to_space ( StgClosure *p )
+{
+ bdescr *bd;
+
+ bd = Bdescr((StgPtr)p);
+ if (HEAP_ALLOCED(p) &&
+ ((bd->flags & BF_EVACUATED)
+ || ((bd->flags & BF_COMPACTED) &&
+ is_marked((P_)p,bd)))) {
+ return rtsTrue;
+ } else {
+ return rtsFalse;
+ }
+}
+
static StgClosure *
eval_thunk_selector( nat field, StgSelector * p )
{
// eval_thunk_selector(). There are various ways this could
// happen:
//
- // - following an IND_STATIC
+ // 1. following an IND_STATIC
//
- // - when the old generation is compacted, the mark phase updates
- // from-space pointers to be to-space pointers, and we can't
- // reliably tell which we're following (eg. from an IND_STATIC).
+ // 2. when the old generation is compacted, the mark phase updates
+ // from-space pointers to be to-space pointers, and we can't
+ // reliably tell which we're following (eg. from an IND_STATIC).
//
- // So we use the block-descriptor test to find out if we're in
- // to-space.
+ // 3. compacting GC again: if we're looking at a constructor in
+ // the compacted generation, it might point directly to objects
+ // in to-space. We must bale out here, otherwise doing the selection
+ // will result in a to-space pointer being returned.
+ //
+ // (1) is dealt with using a BF_EVACUATED test on the
+ // selectee. (2) and (3): we can tell if we're looking at an
+ // object in the compacted generation that might point to
+ // to-space objects by testing that (a) it is BF_COMPACTED, (b)
+ // the compacted generation is being collected, and (c) the
+ // object is marked. Only a marked object may have pointers that
+ // point to to-space objects, because that happens when
+ // scavenging.
//
- if (HEAP_ALLOCED(selectee) &&
- Bdescr((StgPtr)selectee)->flags & BF_EVACUATED) {
+ // The to-space test is now embodied in the in_to_space() inline
+ // function, as it is re-used below.
+ //
+ if (is_to_space(selectee)) {
goto bale_out;
}
ASSERT(field < (StgWord32)(info->layout.payload.ptrs +
info->layout.payload.nptrs));
- // ToDo: shouldn't we test whether this pointer is in
- // to-space?
- return selectee->payload[field];
+ // Select the right field from the constructor, and check
+ // that the result isn't in to-space. It might be in
+ // to-space if, for example, this constructor contains
+ // pointers to younger-gen objects (and is on the mut-once
+ // list).
+ //
+ {
+ StgClosure *q;
+ q = selectee->payload[field];
+ if (is_to_space(q)) {
+ goto bale_out;
+ } else {
+ return q;
+ }
+ }
case IND:
case IND_PERM:
// check that we don't recurse too much, re-using the
// depth bound also used in evacuate().
- thunk_selector_depth++;
- if (thunk_selector_depth > MAX_THUNK_SELECTOR_DEPTH) {
+ if (thunk_selector_depth >= MAX_THUNK_SELECTOR_DEPTH) {
break;
}
+ thunk_selector_depth++;
val = eval_thunk_selector(info->layout.selector_offset,
(StgSelector *)selectee);
// For the purposes of LDV profiling, we have destroyed
// the original selector thunk.
SET_INFO(p, info_ptr);
- LDV_recordDead_FILL_SLOP_DYNAMIC(selectee);
+ LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(selectee);
#endif
((StgInd *)selectee)->indirectee = val;
SET_INFO(selectee,&stg_IND_info);
-#ifdef PROFILING
+
// For the purposes of LDV profiling, we have created an
// indirection.
- LDV_recordCreate(selectee);
-#endif
+ LDV_RECORD_CREATE(selectee);
+
selectee = val;
goto selector_loop;
}
}
case AP:
+ case AP_STACK:
case THUNK:
case THUNK_1_0:
case THUNK_0_1:
* srt field in the info table. That's ok, because we'll
* never dereference it.
*/
-static inline void
+STATIC_INLINE void
scavenge_srt (StgClosure **srt, nat srt_bitmap)
{
nat bitmap;
}
-static inline void
+STATIC_INLINE void
scavenge_thunk_srt(const StgInfoTable *info)
{
StgThunkInfoTable *thunk_info;
thunk_info = itbl_to_thunk_itbl(info);
- scavenge_srt((StgClosure **)thunk_info->srt, thunk_info->i.srt_bitmap);
+ scavenge_srt((StgClosure **)GET_SRT(thunk_info), thunk_info->i.srt_bitmap);
}
-static inline void
+STATIC_INLINE void
scavenge_fun_srt(const StgInfoTable *info)
{
StgFunInfoTable *fun_info;
fun_info = itbl_to_fun_itbl(info);
- scavenge_srt((StgClosure **)fun_info->srt, fun_info->i.srt_bitmap);
+ scavenge_srt((StgClosure **)GET_FUN_SRT(fun_info), fun_info->i.srt_bitmap);
}
-static inline void
+STATIC_INLINE void
scavenge_ret_srt(const StgInfoTable *info)
{
StgRetInfoTable *ret_info;
ret_info = itbl_to_ret_itbl(info);
- scavenge_srt((StgClosure **)ret_info->srt, ret_info->i.srt_bitmap);
+ scavenge_srt((StgClosure **)GET_SRT(ret_info), ret_info->i.srt_bitmap);
}
/* -----------------------------------------------------------------------------
scavengeTSO (StgTSO *tso)
{
// chase the link field for any TSOs on the same queue
- (StgClosure *)tso->link = evacuate((StgClosure *)tso->link);
+ tso->link = (StgTSO *)evacuate((StgClosure *)tso->link);
if ( tso->why_blocked == BlockedOnMVar
|| tso->why_blocked == BlockedOnBlackHole
|| tso->why_blocked == BlockedOnException
(StgTSO *)evacuate((StgClosure *)tso->blocked_exceptions);
}
+ // scavange current transaction record
+ tso->trec = (StgTRecHeader *)evacuate((StgClosure *)tso->trec);
+
// scavenge this thread's stack
scavenge_stack(tso->sp, &(tso->stack[tso->stack_size]));
}
in PAPs.
-------------------------------------------------------------------------- */
-static inline StgPtr
+STATIC_INLINE StgPtr
scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
{
StgPtr p;
nat size;
p = (StgPtr)args;
- switch (fun_info->fun_type) {
+ switch (fun_info->f.fun_type) {
case ARG_GEN:
- bitmap = BITMAP_BITS(fun_info->bitmap);
- size = BITMAP_SIZE(fun_info->bitmap);
+ bitmap = BITMAP_BITS(fun_info->f.bitmap);
+ size = BITMAP_SIZE(fun_info->f.bitmap);
goto small_bitmap;
case ARG_GEN_BIG:
- size = ((StgLargeBitmap *)fun_info->bitmap)->size;
- scavenge_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size);
+ size = GET_FUN_LARGE_BITMAP(fun_info)->size;
+ scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
p += size;
break;
default:
- bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]);
- size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->fun_type]);
+ bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
+ size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
small_bitmap:
while (size > 0) {
if ((bitmap & 1) == 0) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
p++;
bitmap = bitmap >> 1;
return p;
}
-static inline StgPtr
+STATIC_INLINE StgPtr
scavenge_PAP (StgPAP *pap)
{
StgPtr p;
p = (StgPtr)pap->payload;
size = pap->n_args;
- switch (fun_info->fun_type) {
+ switch (fun_info->f.fun_type) {
case ARG_GEN:
- bitmap = BITMAP_BITS(fun_info->bitmap);
+ bitmap = BITMAP_BITS(fun_info->f.bitmap);
goto small_bitmap;
case ARG_GEN_BIG:
- scavenge_large_bitmap(p, (StgLargeBitmap *)fun_info->bitmap, size);
+ scavenge_large_bitmap(p, GET_FUN_LARGE_BITMAP(fun_info), size);
p += size;
break;
case ARG_BCO:
p += size;
break;
default:
- bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->fun_type]);
+ bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
small_bitmap:
size = pap->n_args;
while (size > 0) {
if ((bitmap & 1) == 0) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
p++;
bitmap = bitmap >> 1;
switch (info->type) {
case MVAR:
- /* treat MVars specially, because we don't want to evacuate the
- * mut_link field in the middle of the closure.
- */
{
StgMVar *mvar = ((StgMVar *)p);
evac_gen = 0;
- (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head);
- (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail);
- (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value);
+ mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
+ mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
+ mvar->value = evacuate((StgClosure *)mvar->value);
evac_gen = saved_evac_gen;
- recordMutable((StgMutClosure *)mvar);
- failed_to_evac = rtsFalse; // mutable.
+ failed_to_evac = rtsTrue; // mutable.
p += sizeofW(StgMVar);
break;
}
case THUNK_1_0:
scavenge_thunk_srt(info);
((StgClosure *)p)->payload[0] = evacuate(((StgClosure *)p)->payload[0]);
- p += sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
+ p += sizeofW(StgHeader) + 1;
break;
case FUN_1_0:
case THUNK_0_1:
scavenge_thunk_srt(info);
- p += sizeofW(StgHeader) + 2; // MIN_UPD_SIZE
+ p += sizeofW(StgHeader) + 1;
break;
case FUN_0_1:
end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
p += info->layout.payload.nptrs;
break;
case BCO: {
StgBCO *bco = (StgBCO *)p;
- (StgClosure *)bco->instrs = evacuate((StgClosure *)bco->instrs);
- (StgClosure *)bco->literals = evacuate((StgClosure *)bco->literals);
- (StgClosure *)bco->ptrs = evacuate((StgClosure *)bco->ptrs);
- (StgClosure *)bco->itbls = evacuate((StgClosure *)bco->itbls);
+ bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
+ bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
+ bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
+ bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls);
p += bco_sizeW(bco);
break;
}
LDV_recordDead((StgClosure *)p, sizeofW(StgInd));
#endif
//
- // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
+ // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()?
//
SET_INFO(((StgClosure *)p), &stg_IND_OLDGEN_PERM_info);
-#ifdef PROFILING
- // @LDV profiling
+
// We pretend that p has just been created.
- LDV_recordCreate((StgClosure *)p);
-#endif
+ LDV_RECORD_CREATE((StgClosure *)p);
}
// fall through
case IND_OLDGEN_PERM:
- ((StgIndOldGen *)p)->indirectee =
- evacuate(((StgIndOldGen *)p)->indirectee);
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- recordOldToNewPtrs((StgMutClosure *)p);
- }
- p += sizeofW(StgIndOldGen);
+ ((StgInd *)p)->indirectee = evacuate(((StgInd *)p)->indirectee);
+ p += sizeofW(StgInd);
break;
case MUT_VAR:
evac_gen = 0;
((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
evac_gen = saved_evac_gen;
- recordMutable((StgMutClosure *)p);
- failed_to_evac = rtsFalse; // mutable anyhow
- p += sizeofW(StgMutVar);
- break;
-
- case MUT_CONS:
- // ignore these
- failed_to_evac = rtsFalse; // mutable anyhow
+ failed_to_evac = rtsTrue; // mutable anyhow
p += sizeofW(StgMutVar);
break;
case BLACKHOLE_BQ:
{
StgBlockingQueue *bh = (StgBlockingQueue *)p;
- (StgClosure *)bh->blocking_queue =
- evacuate((StgClosure *)bh->blocking_queue);
- recordMutable((StgMutClosure *)bh);
- failed_to_evac = rtsFalse;
+ bh->blocking_queue =
+ (StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
+ failed_to_evac = rtsTrue;
p += BLACKHOLE_sizeW();
break;
}
evac_gen = 0; // repeatedly mutable
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
evac_gen = saved_evac_gen;
- recordMutable((StgMutClosure *)q);
- failed_to_evac = rtsFalse; // mutable anyhow.
+ failed_to_evac = rtsTrue; // mutable anyhow.
break;
}
case MUT_ARR_PTRS_FROZEN:
+ case MUT_ARR_PTRS_FROZEN0:
// follow everything
{
StgPtr next;
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
// it's tempting to recordMutable() if failed_to_evac is
// false, but that breaks some assumptions (eg. every
evac_gen = 0;
scavengeTSO(tso);
evac_gen = saved_evac_gen;
- recordMutable((StgMutClosure *)tso);
- failed_to_evac = rtsFalse; // mutable anyhow.
+ failed_to_evac = rtsTrue; // mutable anyhow.
p += tso_sizeW(tso);
break;
}
StgRBH *rbh = (StgRBH *)p;
(StgClosure *)rbh->blocking_queue =
evacuate((StgClosure *)rbh->blocking_queue);
- recordMutable((StgMutClosure *)to);
- failed_to_evac = rtsFalse; // mutable anyhow.
+ failed_to_evac = rtsTrue; // mutable anyhow.
IF_DEBUG(gc,
- belch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
+ debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
p, info_type(p), (StgClosure *)rbh->blocking_queue));
// ToDo: use size of reverted closure here!
p += BLACKHOLE_sizeW();
// follow the link to the rest of the blocking queue
(StgClosure *)bf->link =
evacuate((StgClosure *)bf->link);
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- recordMutable((StgMutClosure *)bf);
- }
IF_DEBUG(gc,
- belch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
+ debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
bf, info_type((StgClosure *)bf),
bf->node, info_type(bf->node)));
p += sizeofW(StgBlockedFetch);
StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
(StgClosure *)fmbq->blocking_queue =
evacuate((StgClosure *)fmbq->blocking_queue);
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- recordMutable((StgMutClosure *)fmbq);
- }
IF_DEBUG(gc,
- belch("@@ scavenge: %p (%s) exciting, isn't it",
+ debugBelch("@@ scavenge: %p (%s) exciting, isn't it",
p, info_type((StgClosure *)p)));
p += sizeofW(StgFetchMeBlockingQueue);
break;
}
#endif
+ case TVAR_WAIT_QUEUE:
+ {
+ StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p);
+ evac_gen = 0;
+ wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso);
+ wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry);
+ wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
+ evac_gen = saved_evac_gen;
+ failed_to_evac = rtsTrue; // mutable
+ p += sizeofW(StgTVarWaitQueue);
+ break;
+ }
+
+ case TVAR:
+ {
+ StgTVar *tvar = ((StgTVar *) p);
+ evac_gen = 0;
+ tvar->current_value = evacuate((StgClosure*)tvar->current_value);
+ tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry);
+ evac_gen = saved_evac_gen;
+ failed_to_evac = rtsTrue; // mutable
+ p += sizeofW(StgTVar);
+ break;
+ }
+
+ case TREC_HEADER:
+ {
+ StgTRecHeader *trec = ((StgTRecHeader *) p);
+ evac_gen = 0;
+ trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
+ trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
+ evac_gen = saved_evac_gen;
+ failed_to_evac = rtsTrue; // mutable
+ p += sizeofW(StgTRecHeader);
+ break;
+ }
+
+ case TREC_CHUNK:
+ {
+ StgWord i;
+ StgTRecChunk *tc = ((StgTRecChunk *) p);
+ TRecEntry *e = &(tc -> entries[0]);
+ evac_gen = 0;
+ tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
+ for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
+ e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar);
+ e->expected_value = evacuate((StgClosure*)e->expected_value);
+ e->new_value = evacuate((StgClosure*)e->new_value);
+ }
+ evac_gen = saved_evac_gen;
+ failed_to_evac = rtsTrue; // mutable
+ p += sizeofW(StgTRecChunk);
+ break;
+ }
+
default:
barf("scavenge: unimplemented/strange closure type %d @ %p",
info->type, p);
}
- /* If we didn't manage to promote all the objects pointed to by
- * the current object, then we have to designate this object as
- * mutable (because it contains old-to-new generation pointers).
+ /*
+ * We need to record the current object on the mutable list if
+ * (a) It is actually mutable, or
+ * (b) It contains pointers to a younger generation.
+ * Case (b) arises if we didn't manage to promote everything that
+ * the current object points to into the current generation.
*/
if (failed_to_evac) {
failed_to_evac = rtsFalse;
- mkMutCons((StgClosure *)q, &generations[evac_gen]);
+ recordMutableGen((StgClosure *)q, stp->gen);
}
}
switch (info->type) {
case MVAR:
- /* treat MVars specially, because we don't want to evacuate the
- * mut_link field in the middle of the closure.
- */
{
StgMVar *mvar = ((StgMVar *)p);
evac_gen = 0;
- (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head);
- (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail);
- (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value);
+ mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
+ mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
+ mvar->value = evacuate((StgClosure *)mvar->value);
evac_gen = saved_evac_gen;
- failed_to_evac = rtsFalse; // mutable.
+ failed_to_evac = rtsTrue; // mutable.
break;
}
end = (P_)((StgClosure *)p)->payload + info->layout.payload.ptrs;
for (p = (P_)((StgClosure *)p)->payload; p < end; p++) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
break;
}
case BCO: {
StgBCO *bco = (StgBCO *)p;
- (StgClosure *)bco->instrs = evacuate((StgClosure *)bco->instrs);
- (StgClosure *)bco->literals = evacuate((StgClosure *)bco->literals);
- (StgClosure *)bco->ptrs = evacuate((StgClosure *)bco->ptrs);
- (StgClosure *)bco->itbls = evacuate((StgClosure *)bco->itbls);
+ bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
+ bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
+ bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
+ bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls);
break;
}
case IND_OLDGEN:
case IND_OLDGEN_PERM:
- ((StgIndOldGen *)p)->indirectee =
- evacuate(((StgIndOldGen *)p)->indirectee);
- if (failed_to_evac) {
- recordOldToNewPtrs((StgMutClosure *)p);
- }
- failed_to_evac = rtsFalse;
+ ((StgInd *)p)->indirectee =
+ evacuate(((StgInd *)p)->indirectee);
break;
case MUT_VAR:
evac_gen = 0;
((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
evac_gen = saved_evac_gen;
- failed_to_evac = rtsFalse;
- break;
-
- case MUT_CONS:
- // ignore these
- failed_to_evac = rtsFalse;
+ failed_to_evac = rtsTrue;
break;
case CAF_BLACKHOLE:
case BLACKHOLE_BQ:
{
StgBlockingQueue *bh = (StgBlockingQueue *)p;
- (StgClosure *)bh->blocking_queue =
- evacuate((StgClosure *)bh->blocking_queue);
- failed_to_evac = rtsFalse;
+ bh->blocking_queue =
+ (StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
+ failed_to_evac = rtsTrue;
break;
}
evac_gen = 0; // repeatedly mutable
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
evac_gen = saved_evac_gen;
- failed_to_evac = rtsFalse; // mutable anyhow.
+ failed_to_evac = rtsTrue; // mutable anyhow.
break;
}
case MUT_ARR_PTRS_FROZEN:
+ case MUT_ARR_PTRS_FROZEN0:
// follow everything
{
StgPtr next;
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
break;
}
evac_gen = 0;
scavengeTSO(tso);
evac_gen = saved_evac_gen;
- failed_to_evac = rtsFalse;
+ failed_to_evac = rtsTrue;
break;
}
StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str);
#endif
StgRBH *rbh = (StgRBH *)p;
- (StgClosure *)rbh->blocking_queue =
- evacuate((StgClosure *)rbh->blocking_queue);
- recordMutable((StgMutClosure *)rbh);
- failed_to_evac = rtsFalse; // mutable anyhow.
+ bh->blocking_queue =
+ (StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
+ failed_to_evac = rtsTrue; // mutable anyhow.
IF_DEBUG(gc,
- belch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
+ debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
p, info_type(p), (StgClosure *)rbh->blocking_queue));
break;
}
// follow the link to the rest of the blocking queue
(StgClosure *)bf->link =
evacuate((StgClosure *)bf->link);
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- recordMutable((StgMutClosure *)bf);
- }
IF_DEBUG(gc,
- belch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
+ debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
bf, info_type((StgClosure *)bf),
bf->node, info_type(bf->node)));
break;
StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
(StgClosure *)fmbq->blocking_queue =
evacuate((StgClosure *)fmbq->blocking_queue);
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- recordMutable((StgMutClosure *)fmbq);
- }
IF_DEBUG(gc,
- belch("@@ scavenge: %p (%s) exciting, isn't it",
+ debugBelch("@@ scavenge: %p (%s) exciting, isn't it",
p, info_type((StgClosure *)p)));
break;
}
#endif // PAR
+ case TVAR_WAIT_QUEUE:
+ {
+ StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p);
+ evac_gen = 0;
+ wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso);
+ wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry);
+ wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
+ evac_gen = saved_evac_gen;
+ failed_to_evac = rtsTrue; // mutable
+ break;
+ }
+
+ case TVAR:
+ {
+ StgTVar *tvar = ((StgTVar *) p);
+ evac_gen = 0;
+ tvar->current_value = evacuate((StgClosure*)tvar->current_value);
+ tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry);
+ evac_gen = saved_evac_gen;
+ failed_to_evac = rtsTrue; // mutable
+ break;
+ }
+
+ case TREC_CHUNK:
+ {
+ StgWord i;
+ StgTRecChunk *tc = ((StgTRecChunk *) p);
+ TRecEntry *e = &(tc -> entries[0]);
+ evac_gen = 0;
+ tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
+ for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
+ e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar);
+ e->expected_value = evacuate((StgClosure*)e->expected_value);
+ e->new_value = evacuate((StgClosure*)e->new_value);
+ }
+ evac_gen = saved_evac_gen;
+ failed_to_evac = rtsTrue; // mutable
+ break;
+ }
+
+ case TREC_HEADER:
+ {
+ StgTRecHeader *trec = ((StgTRecHeader *) p);
+ evac_gen = 0;
+ trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
+ trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
+ evac_gen = saved_evac_gen;
+ failed_to_evac = rtsTrue; // mutable
+ break;
+ }
+
default:
barf("scavenge_mark_stack: unimplemented/strange closure type %d @ %p",
info->type, p);
if (failed_to_evac) {
failed_to_evac = rtsFalse;
- mkMutCons((StgClosure *)q, &generations[evac_gen]);
+ recordMutableGen((StgClosure *)q, &generations[evac_gen]);
}
// mark the next bit to indicate "scavenged"
// start a new linear scan if the mark stack overflowed at some point
if (mark_stack_overflowed && oldgen_scan_bd == NULL) {
- IF_DEBUG(gc, belch("scavenge_mark_stack: starting linear scan"));
+ IF_DEBUG(gc, debugBelch("scavenge_mark_stack: starting linear scan"));
mark_stack_overflowed = rtsFalse;
oldgen_scan_bd = oldest_gen->steps[0].blocks;
oldgen_scan = oldgen_scan_bd->start;
switch (info->type) {
+ case MVAR:
+ {
+ StgMVar *mvar = ((StgMVar *)p);
+ evac_gen = 0;
+ mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
+ mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
+ mvar->value = evacuate((StgClosure *)mvar->value);
+ evac_gen = saved_evac_gen;
+ failed_to_evac = rtsTrue; // mutable.
+ break;
+ }
+
case FUN:
case FUN_1_0: // hardly worth specialising these guys
case FUN_0_1:
case WEAK:
case FOREIGN:
case IND_PERM:
- case IND_OLDGEN_PERM:
{
StgPtr q, end;
end = (StgPtr)((StgClosure *)p)->payload + info->layout.payload.ptrs;
for (q = (StgPtr)((StgClosure *)p)->payload; q < end; q++) {
- (StgClosure *)*q = evacuate((StgClosure *)*q);
+ *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
}
break;
}
+ case MUT_VAR:
+ evac_gen = 0;
+ ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
+ evac_gen = saved_evac_gen;
+ failed_to_evac = rtsTrue; // mutable anyhow
+ break;
+
case CAF_BLACKHOLE:
case SE_CAF_BLACKHOLE:
case SE_BLACKHOLE:
case BLACKHOLE:
break;
+ case BLACKHOLE_BQ:
+ {
+ StgBlockingQueue *bh = (StgBlockingQueue *)p;
+ evac_gen = 0; // repeatedly mutable
+ bh->blocking_queue =
+ (StgTSO *)evacuate((StgClosure *)bh->blocking_queue);
+ failed_to_evac = rtsTrue;
+ break;
+ }
+
case THUNK_SELECTOR:
{
StgSelector *s = (StgSelector *)p;
break;
}
+ case AP_STACK:
+ {
+ StgAP_STACK *ap = (StgAP_STACK *)p;
+
+ ap->fun = evacuate(ap->fun);
+ scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
+ p = (StgPtr)ap->payload + ap->size;
+ break;
+ }
+
+ case PAP:
+ case AP:
+ p = scavenge_PAP((StgPAP *)p);
+ break;
+
case ARR_WORDS:
// nothing to follow
break;
StgPtr next;
evac_gen = 0; // repeatedly mutable
- recordMutable((StgMutClosure *)p);
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
evac_gen = saved_evac_gen;
- failed_to_evac = rtsFalse;
+ failed_to_evac = rtsTrue;
break;
}
case MUT_ARR_PTRS_FROZEN:
+ case MUT_ARR_PTRS_FROZEN0:
{
// follow everything
StgPtr next;
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
break;
}
evac_gen = 0; // repeatedly mutable
scavengeTSO(tso);
- recordMutable((StgMutClosure *)tso);
evac_gen = saved_evac_gen;
- failed_to_evac = rtsFalse;
+ failed_to_evac = rtsTrue;
break;
}
- case AP_STACK:
- {
- StgAP_STACK *ap = (StgAP_STACK *)p;
-
- ap->fun = evacuate(ap->fun);
- scavenge_stack((StgPtr)ap->payload, (StgPtr)ap->payload + ap->size);
- p = (StgPtr)ap->payload + ap->size;
+#if defined(PAR)
+ case RBH: // cf. BLACKHOLE_BQ
+ {
+#if 0
+ nat size, ptrs, nonptrs, vhs;
+ char str[80];
+ StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str);
+#endif
+ StgRBH *rbh = (StgRBH *)p;
+ (StgClosure *)rbh->blocking_queue =
+ evacuate((StgClosure *)rbh->blocking_queue);
+ failed_to_evac = rtsTrue; // mutable anyhow.
+ IF_DEBUG(gc,
+ debugBelch("@@ scavenge: RBH %p (%s) (new blocking_queue link=%p)",
+ p, info_type(p), (StgClosure *)rbh->blocking_queue));
+ // ToDo: use size of reverted closure here!
break;
}
- case PAP:
- case AP:
- p = scavenge_PAP((StgPAP *)p);
- break;
-
- case IND_OLDGEN:
- // This might happen if for instance a MUT_CONS was pointing to a
- // THUNK which has since been updated. The IND_OLDGEN will
- // be on the mutable list anyway, so we don't need to do anything
- // here.
+ case BLOCKED_FETCH:
+ {
+ StgBlockedFetch *bf = (StgBlockedFetch *)p;
+ // follow the pointer to the node which is being demanded
+ (StgClosure *)bf->node =
+ evacuate((StgClosure *)bf->node);
+ // follow the link to the rest of the blocking queue
+ (StgClosure *)bf->link =
+ evacuate((StgClosure *)bf->link);
+ IF_DEBUG(gc,
+ debugBelch("@@ scavenge: %p (%s); node is now %p; exciting, isn't it",
+ bf, info_type((StgClosure *)bf),
+ bf->node, info_type(bf->node)));
break;
+ }
- default:
- barf("scavenge_one: strange object %d", (int)(info->type));
- }
-
- no_luck = failed_to_evac;
- failed_to_evac = rtsFalse;
- return (no_luck);
-}
-
-/* -----------------------------------------------------------------------------
- Scavenging mutable lists.
+#ifdef DIST
+ case REMOTE_REF:
+#endif
+ case FETCH_ME:
+ break; // nothing to do in this case
- We treat the mutable list of each generation > N (i.e. all the
- generations older than the one being collected) as roots. We also
- remove non-mutable objects from the mutable list at this point.
- -------------------------------------------------------------------------- */
+ case FETCH_ME_BQ: // cf. BLACKHOLE_BQ
+ {
+ StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
+ (StgClosure *)fmbq->blocking_queue =
+ evacuate((StgClosure *)fmbq->blocking_queue);
+ IF_DEBUG(gc,
+ debugBelch("@@ scavenge: %p (%s) exciting, isn't it",
+ p, info_type((StgClosure *)p)));
+ break;
+ }
+#endif
-static void
-scavenge_mut_once_list(generation *gen)
-{
- const StgInfoTable *info;
- StgMutClosure *p, *next, *new_list;
+ case TVAR_WAIT_QUEUE:
+ {
+ StgTVarWaitQueue *wq = ((StgTVarWaitQueue *) p);
+ evac_gen = 0;
+ wq->waiting_tso = (StgTSO *)evacuate((StgClosure*)wq->waiting_tso);
+ wq->next_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->next_queue_entry);
+ wq->prev_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)wq->prev_queue_entry);
+ evac_gen = saved_evac_gen;
+ failed_to_evac = rtsTrue; // mutable
+ break;
+ }
- p = gen->mut_once_list;
- new_list = END_MUT_LIST;
- next = p->mut_link;
+ case TVAR:
+ {
+ StgTVar *tvar = ((StgTVar *) p);
+ evac_gen = 0;
+ tvar->current_value = evacuate((StgClosure*)tvar->current_value);
+ tvar->first_wait_queue_entry = (StgTVarWaitQueue *)evacuate((StgClosure*)tvar->first_wait_queue_entry);
+ evac_gen = saved_evac_gen;
+ failed_to_evac = rtsTrue; // mutable
+ break;
+ }
- evac_gen = gen->no;
- failed_to_evac = rtsFalse;
+ case TREC_HEADER:
+ {
+ StgTRecHeader *trec = ((StgTRecHeader *) p);
+ evac_gen = 0;
+ trec->enclosing_trec = (StgTRecHeader *)evacuate((StgClosure*)trec->enclosing_trec);
+ trec->current_chunk = (StgTRecChunk *)evacuate((StgClosure*)trec->current_chunk);
+ evac_gen = saved_evac_gen;
+ failed_to_evac = rtsTrue; // mutable
+ break;
+ }
- for (; p != END_MUT_LIST; p = next, next = p->mut_link) {
+ case TREC_CHUNK:
+ {
+ StgWord i;
+ StgTRecChunk *tc = ((StgTRecChunk *) p);
+ TRecEntry *e = &(tc -> entries[0]);
+ evac_gen = 0;
+ tc->prev_chunk = (StgTRecChunk *)evacuate((StgClosure*)tc->prev_chunk);
+ for (i = 0; i < tc -> next_entry_idx; i ++, e++ ) {
+ e->tvar = (StgTVar *)evacuate((StgClosure*)e->tvar);
+ e->expected_value = evacuate((StgClosure*)e->expected_value);
+ e->new_value = evacuate((StgClosure*)e->new_value);
+ }
+ evac_gen = saved_evac_gen;
+ failed_to_evac = rtsTrue; // mutable
+ break;
+ }
- ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
- info = get_itbl(p);
- /*
- if (info->type==RBH)
- info = REVERT_INFOPTR(info); // if it's an RBH, look at the orig closure
- */
- switch(info->type) {
-
case IND_OLDGEN:
case IND_OLDGEN_PERM:
case IND_STATIC:
- /* Try to pull the indirectee into this generation, so we can
- * remove the indirection from the mutable list.
- */
- ((StgIndOldGen *)p)->indirectee =
- evacuate(((StgIndOldGen *)p)->indirectee);
-
+ {
+ /* Careful here: a THUNK can be on the mutable list because
+ * it contains pointers to young gen objects. If such a thunk
+ * is updated, the IND_OLDGEN will be added to the mutable
+ * list again, and we'll scavenge it twice. evacuate()
+ * doesn't check whether the object has already been
+ * evacuated, so we perform that check here.
+ */
+ StgClosure *q = ((StgInd *)p)->indirectee;
+ if (HEAP_ALLOCED(q) && Bdescr((StgPtr)q)->flags & BF_EVACUATED) {
+ break;
+ }
+ ((StgInd *)p)->indirectee = evacuate(q);
+ }
+
#if 0 && defined(DEBUG)
if (RtsFlags.DebugFlags.gc)
/* Debugging code to print out the size of the thing we just
} else {
size = gen->steps[0].scan - start;
}
- belch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_));
+ debugBelch("evac IND_OLDGEN: %ld bytes", size * sizeof(W_));
}
#endif
-
- /* failed_to_evac might happen if we've got more than two
- * generations, we're collecting only generation 0, the
- * indirection resides in generation 2 and the indirectee is
- * in generation 1.
- */
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- p->mut_link = new_list;
- new_list = p;
- } else {
- /* the mut_link field of an IND_STATIC is overloaded as the
- * static link field too (it just so happens that we don't need
- * both at the same time), so we need to NULL it out when
- * removing this object from the mutable list because the static
- * link fields are all assumed to be NULL before doing a major
- * collection.
- */
- p->mut_link = NULL;
- }
- continue;
-
- case MUT_CONS:
- /* MUT_CONS is a kind of MUT_VAR, except it that we try to remove
- * it from the mutable list if possible by promoting whatever it
- * points to.
- */
- if (scavenge_one((StgPtr)((StgMutVar *)p)->var)) {
- /* didn't manage to promote everything, so put the
- * MUT_CONS back on the list.
- */
- p->mut_link = new_list;
- new_list = p;
- }
- continue;
+ break;
default:
- // shouldn't have anything else on the mutables list
- barf("scavenge_mut_once_list: strange object? %d", (int)(info->type));
- }
- }
+ barf("scavenge_one: strange object %d", (int)(info->type));
+ }
- gen->mut_once_list = new_list;
+ no_luck = failed_to_evac;
+ failed_to_evac = rtsFalse;
+ return (no_luck);
}
+/* -----------------------------------------------------------------------------
+ Scavenging mutable lists.
+
+ We treat the mutable list of each generation > N (i.e. all the
+ generations older than the one being collected) as roots. We also
+ remove non-mutable objects from the mutable list at this point.
+ -------------------------------------------------------------------------- */
static void
scavenge_mutable_list(generation *gen)
{
- const StgInfoTable *info;
- StgMutClosure *p, *next;
-
- p = gen->saved_mut_list;
- next = p->mut_link;
-
- evac_gen = 0;
- failed_to_evac = rtsFalse;
-
- for (; p != END_MUT_LIST; p = next, next = p->mut_link) {
-
- ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
- info = get_itbl(p);
- /*
- if (info->type==RBH)
- info = REVERT_INFOPTR(info); // if it's an RBH, look at the orig closure
- */
- switch(info->type) {
-
- case MUT_ARR_PTRS:
- // follow everything
- p->mut_link = gen->mut_list;
- gen->mut_list = p;
- {
- StgPtr end, q;
-
- end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
- for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) {
- (StgClosure *)*q = evacuate((StgClosure *)*q);
- }
- continue;
- }
-
- // Happens if a MUT_ARR_PTRS in the old generation is frozen
- case MUT_ARR_PTRS_FROZEN:
- {
- StgPtr end, q;
-
- evac_gen = gen->no;
- end = (P_)p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
- for (q = (P_)((StgMutArrPtrs *)p)->payload; q < end; q++) {
- (StgClosure *)*q = evacuate((StgClosure *)*q);
- }
- evac_gen = 0;
- p->mut_link = NULL;
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- mkMutCons((StgClosure *)p, gen);
- }
- continue;
- }
-
- case MUT_VAR:
- ((StgMutVar *)p)->var = evacuate(((StgMutVar *)p)->var);
- p->mut_link = gen->mut_list;
- gen->mut_list = p;
- continue;
-
- case MVAR:
- {
- StgMVar *mvar = (StgMVar *)p;
- (StgClosure *)mvar->head = evacuate((StgClosure *)mvar->head);
- (StgClosure *)mvar->tail = evacuate((StgClosure *)mvar->tail);
- (StgClosure *)mvar->value = evacuate((StgClosure *)mvar->value);
- p->mut_link = gen->mut_list;
- gen->mut_list = p;
- continue;
- }
-
- case TSO:
- {
- StgTSO *tso = (StgTSO *)p;
-
- scavengeTSO(tso);
-
- /* Don't take this TSO off the mutable list - it might still
- * point to some younger objects (because we set evac_gen to 0
- * above).
- */
- tso->mut_link = gen->mut_list;
- gen->mut_list = (StgMutClosure *)tso;
- continue;
- }
-
- case BLACKHOLE_BQ:
- {
- StgBlockingQueue *bh = (StgBlockingQueue *)p;
- (StgClosure *)bh->blocking_queue =
- evacuate((StgClosure *)bh->blocking_queue);
- p->mut_link = gen->mut_list;
- gen->mut_list = p;
- continue;
- }
-
- /* Happens if a BLACKHOLE_BQ in the old generation is updated:
- */
- case IND_OLDGEN:
- case IND_OLDGEN_PERM:
- /* Try to pull the indirectee into this generation, so we can
- * remove the indirection from the mutable list.
- */
- evac_gen = gen->no;
- ((StgIndOldGen *)p)->indirectee =
- evacuate(((StgIndOldGen *)p)->indirectee);
- evac_gen = 0;
-
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- p->mut_link = gen->mut_once_list;
- gen->mut_once_list = p;
- } else {
- p->mut_link = NULL;
- }
- continue;
-
-#if defined(PAR)
- // HWL: check whether all of these are necessary
-
- case RBH: // cf. BLACKHOLE_BQ
- {
- // nat size, ptrs, nonptrs, vhs;
- // char str[80];
- // StgInfoTable *rip = get_closure_info(p, &size, &ptrs, &nonptrs, &vhs, str);
- StgRBH *rbh = (StgRBH *)p;
- (StgClosure *)rbh->blocking_queue =
- evacuate((StgClosure *)rbh->blocking_queue);
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- recordMutable((StgMutClosure *)rbh);
- }
- // ToDo: use size of reverted closure here!
- p += BLACKHOLE_sizeW();
- break;
- }
-
- case BLOCKED_FETCH:
- {
- StgBlockedFetch *bf = (StgBlockedFetch *)p;
- // follow the pointer to the node which is being demanded
- (StgClosure *)bf->node =
- evacuate((StgClosure *)bf->node);
- // follow the link to the rest of the blocking queue
- (StgClosure *)bf->link =
- evacuate((StgClosure *)bf->link);
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- recordMutable((StgMutClosure *)bf);
- }
- p += sizeofW(StgBlockedFetch);
- break;
- }
+ bdescr *bd;
+ StgPtr p, q;
-#ifdef DIST
- case REMOTE_REF:
- barf("scavenge_mutable_list: REMOTE_REF %d", (int)(info->type));
-#endif
- case FETCH_ME:
- p += sizeofW(StgFetchMe);
- break; // nothing to do in this case
+ bd = gen->saved_mut_list;
- case FETCH_ME_BQ: // cf. BLACKHOLE_BQ
- {
- StgFetchMeBlockingQueue *fmbq = (StgFetchMeBlockingQueue *)p;
- (StgClosure *)fmbq->blocking_queue =
- evacuate((StgClosure *)fmbq->blocking_queue);
- if (failed_to_evac) {
- failed_to_evac = rtsFalse;
- recordMutable((StgMutClosure *)fmbq);
+ evac_gen = gen->no;
+ for (; bd != NULL; bd = bd->link) {
+ for (q = bd->start; q < bd->free; q++) {
+ p = (StgPtr)*q;
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
+ if (scavenge_one(p)) {
+ /* didn't manage to promote everything, so put the
+ * object back on the list.
+ */
+ recordMutableGen((StgClosure *)p,gen);
+ }
}
- p += sizeofW(StgFetchMeBlockingQueue);
- break;
- }
-#endif
-
- default:
- // shouldn't have anything else on the mutables list
- barf("scavenge_mutable_list: strange object? %d", (int)(info->type));
}
- }
+
+ // free the old mut_list
+ freeChain(gen->saved_mut_list);
+ gen->saved_mut_list = NULL;
}
ind->indirectee = evacuate(ind->indirectee);
/* might fail to evacuate it, in which case we have to pop it
- * back on the mutable list (and take it off the
- * scavenged_static list because the static link and mut link
- * pointers are one and the same).
+ * back on the mutable list of the oldest generation. We
+ * leave it *on* the scavenged_static_objects list, though,
+ * in case we visit this object again.
*/
if (failed_to_evac) {
failed_to_evac = rtsFalse;
- scavenged_static_objects = IND_STATIC_LINK(p);
- ((StgMutClosure *)ind)->mut_link = oldest_gen->mut_once_list;
- oldest_gen->mut_once_list = (StgMutClosure *)ind;
+ recordMutableGen((StgClosure *)p,oldest_gen);
}
break;
}
next = (P_)p->payload + info->layout.payload.ptrs;
// evacuate the pointers
for (q = (P_)p->payload; q < next; q++) {
- (StgClosure *)*q = evacuate((StgClosure *)*q);
+ *q = (StgWord)(StgPtr)evacuate((StgClosure *)*q);
}
break;
}
bitmap = large_bitmap->bitmap[b];
for (i = 0; i < size; ) {
if ((bitmap & 1) == 0) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
i++;
p++;
}
}
-static inline StgPtr
+STATIC_INLINE StgPtr
scavenge_small_bitmap (StgPtr p, nat size, StgWord bitmap)
{
while (size > 0) {
if ((bitmap & 1) == 0) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
}
p++;
bitmap = bitmap >> 1;
StgWord bitmap;
nat size;
- //IF_DEBUG(sanity, belch(" scavenging stack between %p and %p", p, stack_end));
+ //IF_DEBUG(sanity, debugBelch(" scavenging stack between %p and %p", p, stack_end));
/*
* Each time around this loop, we are looking at a chunk of stack
continue;
// small bitmap (< 32 entries, or 64 on a 64-bit machine)
+ case CATCH_STM_FRAME:
+ case CATCH_RETRY_FRAME:
+ case ATOMICALLY_FRAME:
case STOP_FRAME:
case CATCH_FRAME:
case RET_SMALL:
p = scavenge_small_bitmap(p, size, bitmap);
follow_srt:
- scavenge_srt((StgClosure **)info->srt, info->i.srt_bitmap);
+ scavenge_srt((StgClosure **)GET_SRT(info), info->i.srt_bitmap);
continue;
case RET_BCO: {
nat size;
p++;
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
bco = (StgBCO *)*p;
p++;
size = BCO_BITMAP_SIZE(bco);
{
nat size;
- size = info->i.layout.large_bitmap->size;
+ size = GET_LARGE_BITMAP(&info->i)->size;
p++;
- scavenge_large_bitmap(p, info->i.layout.large_bitmap, size);
+ scavenge_large_bitmap(p, GET_LARGE_BITMAP(&info->i), size);
p += size;
// and don't forget to follow the SRT
goto follow_srt;
dyn = ((StgRetDyn *)p)->liveness;
// traverse the bitmap first
- bitmap = GET_LIVENESS(dyn);
+ bitmap = RET_DYN_LIVENESS(dyn);
p = (P_)&((StgRetDyn *)p)->payload[0];
size = RET_DYN_BITMAP_SIZE;
p = scavenge_small_bitmap(p, size, bitmap);
// skip over the non-ptr words
- p += GET_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
+ p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
// follow the ptr words
- for (size = GET_PTRS(dyn); size > 0; size--) {
- (StgClosure *)*p = evacuate((StgClosure *)*p);
+ for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
+ *p = (StgWord)(StgPtr)evacuate((StgClosure *)*p);
p++;
}
continue;
p = bd->start;
if (scavenge_one(p)) {
- mkMutCons((StgClosure *)p, stp->gen);
+ recordMutableGen((StgClosure *)p, stp->gen);
}
}
}
}
}
-/* This function is only needed because we share the mutable link
- * field with the static link field in an IND_STATIC, so we have to
- * zero the mut_link field before doing a major GC, which needs the
- * static link field.
- *
- * It doesn't do any harm to zero all the mutable link fields on the
- * mutable list.
- */
-
-static void
-zero_mutable_list( StgMutClosure *first )
-{
- StgMutClosure *next, *c;
-
- for (c = first; c != END_MUT_LIST; c = next) {
- next = c->mut_link;
- c->mut_link = NULL;
- }
-}
-
/* -----------------------------------------------------------------------------
Reverting CAFs
-------------------------------------------------------------------------- */
{
StgIndStatic *c;
- for (c = (StgIndStatic *)caf_list; c != NULL;
+ for (c = (StgIndStatic *)revertible_caf_list; c != NULL;
c = (StgIndStatic *)c->static_link)
{
- c->header.info = c->saved_info;
+ SET_INFO(c, c->saved_info);
c->saved_info = NULL;
// could, but not necessary: c->static_link = NULL;
}
- caf_list = NULL;
+ revertible_caf_list = NULL;
}
void
{
evac(&c->indirectee);
}
+ for (c = (StgIndStatic *)revertible_caf_list; c != NULL;
+ c = (StgIndStatic *)c->static_link)
+ {
+ evac(&c->indirectee);
+ }
}
/* -----------------------------------------------------------------------------
ASSERT(info->type == IND_STATIC);
if (STATIC_LINK(info,p) == NULL) {
- IF_DEBUG(gccafs, belch("CAF gc'd at 0x%04lx", (long)p));
+ IF_DEBUG(gccafs, debugBelch("CAF gc'd at 0x%04lx", (long)p));
// black hole it
SET_INFO(p,&stg_BLACKHOLE_info);
p = STATIC_LINK2(info,p);
}
- // belch("%d CAFs live", i);
+ // debugBelch("%d CAFs live", i);
}
#endif
if (bh->header.info != &stg_BLACKHOLE_BQ_info &&
bh->header.info != &stg_CAF_BLACKHOLE_info) {
#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
- belch("Unexpected lazy BHing required at 0x%04x",(int)bh);
+ debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh);
#endif
#ifdef PROFILING
// @LDV profiling
LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
#endif
SET_INFO(bh,&stg_BLACKHOLE_info);
-#ifdef PROFILING
- // @LDV profiling
+
// We pretend that bh has just been created.
- LDV_recordCreate(bh);
-#endif
+ LDV_RECORD_CREATE(bh);
}
frame = (StgClosure *) ((StgUpdateFrame *)frame + 1);
// normal stack frames; do nothing except advance the pointer
default:
- (StgPtr)frame += stack_frame_sizeW(frame);
+ frame = (StgClosure *)((StgPtr)frame + stack_frame_sizeW(frame));
}
}
}
bh->header.info != &stg_BLACKHOLE_BQ_info &&
bh->header.info != &stg_CAF_BLACKHOLE_info) {
#if (!defined(LAZY_BLACKHOLING)) && defined(DEBUG)
- belch("Unexpected lazy BHing required at 0x%04x",(int)bh);
+ debugBelch("Unexpected lazy BHing required at 0x%04x",(int)bh);
#endif
#ifdef DEBUG
/* zero out the slop so that the sanity checker can tell
* same size as a BLACKHOLE in any case.
*/
if (bh_info->type != THUNK_SELECTOR) {
- for (i = np; i < np + nw; i++) {
- ((StgClosure *)bh)->payload[i] = 0;
+ for (i = 0; i < np + nw; i++) {
+ ((StgClosure *)bh)->payload[i] = INVALID_OBJECT;
}
}
}
// We pretend that bh is now dead.
LDV_recordDead_FILL_SLOP_DYNAMIC((StgClosure *)bh);
#endif
- // Todo: maybe use SET_HDR() and remove LDV_recordCreate()?
+ // Todo: maybe use SET_HDR() and remove LDV_RECORD_CREATE()?
SET_INFO(bh,&stg_BLACKHOLE_info);
-#ifdef PROFILING
+
// We pretend that bh has just been created.
- LDV_recordCreate(bh);
-#endif
+ LDV_RECORD_CREATE(bh);
}
prev_was_update_frame = rtsTrue;
void *gap_start, *next_gap_start, *gap_end;
nat chunk_size;
- next_gap_start = (void *)gap + sizeof(StgUpdateFrame);
+ next_gap_start = (void *)((unsigned char*)gap + sizeof(StgUpdateFrame));
sp = next_gap_start;
while ((StgPtr)gap > tso->sp) {
// we're working in *bytes* now...
gap_start = next_gap_start;
- gap_end = gap_start - gap->gap_size * sizeof(W_);
+ gap_end = (void*) ((unsigned char*)gap_start - gap->gap_size * sizeof(W_));
gap = gap->next_gap;
- next_gap_start = (void *)gap + sizeof(StgUpdateFrame);
+ next_gap_start = (void *)((unsigned char*)gap + sizeof(StgUpdateFrame));
- chunk_size = gap_end - next_gap_start;
+ chunk_size = (unsigned char*)gap_end - (unsigned char*)next_gap_start;
sp -= chunk_size;
memmove(sp, next_gap_start, chunk_size);
}
#if DEBUG
void
-printMutOnceList(generation *gen)
-{
- StgMutClosure *p, *next;
-
- p = gen->mut_once_list;
- next = p->mut_link;
-
- fprintf(stderr, "@@ Mut once list %p: ", gen->mut_once_list);
- for (; p != END_MUT_LIST; p = next, next = p->mut_link) {
- fprintf(stderr, "%p (%s), ",
- p, info_type((StgClosure *)p));
- }
- fputc('\n', stderr);
-}
-
-void
printMutableList(generation *gen)
{
- StgMutClosure *p, *next;
+ bdescr *bd;
+ StgPtr p;
- p = gen->mut_list;
- next = p->mut_link;
+ debugBelch("@@ Mutable list %p: ", gen->mut_list);
- fprintf(stderr, "@@ Mutable list %p: ", gen->mut_list);
- for (; p != END_MUT_LIST; p = next, next = p->mut_link) {
- fprintf(stderr, "%p (%s), ",
- p, info_type((StgClosure *)p));
- }
- fputc('\n', stderr);
+ for (bd = gen->mut_list; bd != NULL; bd = bd->link) {
+ for (p = bd->start; p < bd->free; p++) {
+ debugBelch("%p (%s), ", (void *)*p, info_type((StgClosure *)*p));
+ }
+ }
+ debugBelch("\n");
}
-static inline rtsBool
+STATIC_INLINE rtsBool
maybeLarge(StgClosure *closure)
{
StgInfoTable *info = get_itbl(closure);
see scavenge_large */
return (info->type == MUT_ARR_PTRS ||
info->type == MUT_ARR_PTRS_FROZEN ||
+ info->type == MUT_ARR_PTRS_FROZEN0 ||
info->type == TSO ||
info->type == ARR_WORDS);
}
projects / ghc-hetmet.git / blobdiff