/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.146 2002/12/11 15:36:42 simonmar Exp $
+ * $Id: GC.c,v 1.168 2004/08/13 13:09:49 simonmar Exp $
*
- * (c) The GHC Team 1998-2002
+ * (c) The GHC Team 1998-2003
*
* Generational garbage collector
*
#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 "Main.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"
#endif
#include "RetainerProfile.h"
-#include "LdvProfile.h"
#include <string.h>
static bdescr * gc_alloc_block ( step *stp );
static void mark_root ( StgClosure **root );
-static StgClosure * evacuate ( StgClosure *q );
+
+// Use a register argument for evacuate, if available.
+#if __GNUC__ >= 2
+#define REGPARM1 __attribute__((regparm(1)))
+#else
+#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 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;
Now, Now));
#endif
-#ifndef mingw32_TARGET_OS
+#if defined(RTS_USER_SIGNALS)
// block signals
blockUserSignals();
#endif
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
// 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
// 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;
}
}
}
*/
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.
// 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;
// ok, GC over: tell the stats department what happened.
stat_endGC(allocated, collected, live, copied, N);
-#ifndef mingw32_TARGET_OS
+#if defined(RTS_USER_SIGNALS)
// unblock signals again
unblockUserSignals();
#endif
default:
barf("traverse_weak_ptr_list");
+ return rtsTrue;
}
}
}
// 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);
if M < evac_gen set failed_to_evac flag to indicate that we
didn't manage to evacuate this object into evac_gen.
+
+ OPTIMISATION NOTES:
+
+ evacuate() is the single most important function performance-wise
+ in the GC. Various things have been tried to speed it up, but as
+ far as I can tell the code generated by gcc 3.2 with -O2 is about
+ as good as it's going to get. We pass the argument to evacuate()
+ in a register using the 'regparm' attribute (see the prototype for
+ evacuate() near the top of this file).
+
+ Changing evacuate() to take an (StgClosure **) rather than
+ returning the new pointer seems attractive, because we can avoid
+ writing back the pointer when it hasn't changed (eg. for a static
+ object, or an object in a generation > N). However, I tried it and
+ it doesn't help. One reason is that the (StgClosure **) pointer
+ gets spilled to the stack inside evacuate(), resulting in far more
+ 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()) {
case WEAK:
case FOREIGN:
case STABLE_NAME:
- case BCO:
return copy(q,sizeW_fromITBL(info),stp);
+ case BCO:
+ return copy(q,bco_sizeW((StgBCO *)q),stp);
+
case CAF_BLACKHOLE:
case SE_CAF_BLACKHOLE:
case SE_BLACKHOLE:
goto loop;
case THUNK_STATIC:
- if (info->srt_len > 0 && major_gc &&
+ if (info->srt_bitmap != 0 && major_gc &&
THUNK_STATIC_LINK((StgClosure *)q) == NULL) {
THUNK_STATIC_LINK((StgClosure *)q) = static_objects;
static_objects = (StgClosure *)q;
return q;
case FUN_STATIC:
- if (info->srt_len > 0 && major_gc &&
+ if (info->srt_bitmap != 0 && major_gc &&
FUN_STATIC_LINK((StgClosure *)q) == NULL) {
FUN_STATIC_LINK((StgClosure *)q) = static_objects;
static_objects = (StgClosure *)q;
* list it contains.
*/
{
- StgTSO *new_tso = (StgTSO *)copy((StgClosure *)tso,tso_sizeW(tso),stp);
+ StgTSO *new_tso;
+ StgPtr p, q;
+
+ new_tso = (StgTSO *)copyPart((StgClosure *)tso,
+ tso_sizeW(tso),
+ sizeofW(StgTSO), stp);
move_TSO(tso, new_tso);
+ for (p = tso->sp, q = new_tso->sp;
+ p < tso->stack+tso->stack_size;) {
+ *q++ = *p++;
+ }
+
return (StgClosure *)new_tso;
}
}
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 )
{
selector_loop:
+ // We don't want to end up in to-space, because this causes
+ // problems when the GC later tries to evacuate the result of
+ // eval_thunk_selector(). There are various ways this could
+ // happen:
+ //
+ // 1. following 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).
+ //
+ // 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.
+ //
+ // 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;
+ }
+
info = get_itbl(selectee);
switch (info->type) {
case CONSTR:
ASSERT(field < (StgWord32)(info->layout.payload.ptrs +
info->layout.payload.nptrs));
- 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:
case IND_OLDGEN:
case IND_OLDGEN_PERM:
+ case IND_STATIC:
selectee = ((StgInd *)selectee)->indirectee;
goto selector_loop;
// leaks by evaluating this selector thunk anyhow.
break;
- case IND_STATIC:
- // We can't easily tell whether the indirectee is into
- // from or to-space, so just bail out here.
- break;
-
case THUNK_SELECTOR:
{
StgClosure *val;
// because we are guaranteed that p is in a generation
// that we are collecting, and we never want to put the
// indirection on a mutable list.
+#ifdef PROFILING
+ // For the purposes of LDV profiling, we have destroyed
+ // the original selector thunk.
+ SET_INFO(p, info_ptr);
+ LDV_RECORD_DEAD_FILL_SLOP_DYNAMIC(selectee);
+#endif
((StgInd *)selectee)->indirectee = val;
SET_INFO(selectee,&stg_IND_info);
+
+ // For the purposes of LDV profiling, we have created an
+ // indirection.
+ LDV_RECORD_CREATE(selectee);
+
selectee = val;
goto selector_loop;
}
}
case AP:
+ case AP_STACK:
case THUNK:
case THUNK_1_0:
case THUNK_0_1:
(int)(info->type));
}
+bale_out:
// We didn't manage to evaluate this thunk; restore the old info pointer
SET_INFO(p, info_ptr);
return NULL;
{
ptrdiff_t diff;
- // relocate the stack pointers...
+ // relocate the stack pointer...
diff = (StgPtr)dest - (StgPtr)src; // In *words*
dest->sp = (StgPtr)dest->sp + diff;
}
-/* evacuate the SRT. If srt_len is zero, then there isn't an
+/* Similar to scavenge_large_bitmap(), but we don't write back the
+ * pointers we get back from evacuate().
+ */
+static void
+scavenge_large_srt_bitmap( StgLargeSRT *large_srt )
+{
+ nat i, b, size;
+ StgWord bitmap;
+ StgClosure **p;
+
+ b = 0;
+ bitmap = large_srt->l.bitmap[b];
+ size = (nat)large_srt->l.size;
+ p = (StgClosure **)large_srt->srt;
+ for (i = 0; i < size; ) {
+ if ((bitmap & 1) != 0) {
+ evacuate(*p);
+ }
+ i++;
+ p++;
+ if (i % BITS_IN(W_) == 0) {
+ b++;
+ bitmap = large_srt->l.bitmap[b];
+ } else {
+ bitmap = bitmap >> 1;
+ }
+ }
+}
+
+/* evacuate the SRT. If srt_bitmap is zero, then there isn't an
* srt field in the info table. That's ok, because we'll
* never dereference it.
*/
-static inline void
-scavenge_srt (StgClosure **srt, nat srt_len)
+STATIC_INLINE void
+scavenge_srt (StgClosure **srt, nat srt_bitmap)
{
- StgClosure **srt_end;
+ nat bitmap;
+ StgClosure **p;
- srt_end = srt + srt_len;
+ bitmap = srt_bitmap;
+ p = srt;
- for (; srt < srt_end; srt++) {
- /* Special-case to handle references to closures hiding out in DLLs, since
- double indirections required to get at those. The code generator knows
- which is which when generating the SRT, so it stores the (indirect)
- reference to the DLL closure in the table by first adding one to it.
- We check for this here, and undo the addition before evacuating it.
+ if (bitmap == (StgHalfWord)(-1)) {
+ scavenge_large_srt_bitmap( (StgLargeSRT *)srt );
+ return;
+ }
- If the SRT entry hasn't got bit 0 set, the SRT entry points to a
- closure that's fixed at link-time, and no extra magic is required.
- */
+ while (bitmap != 0) {
+ if ((bitmap & 1) != 0) {
#ifdef ENABLE_WIN32_DLL_SUPPORT
- if ( (unsigned long)(*srt) & 0x1 ) {
- evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)));
- } else {
- evacuate(*srt);
- }
+ // Special-case to handle references to closures hiding out in DLLs, since
+ // double indirections required to get at those. The code generator knows
+ // which is which when generating the SRT, so it stores the (indirect)
+ // reference to the DLL closure in the table by first adding one to it.
+ // We check for this here, and undo the addition before evacuating it.
+ //
+ // If the SRT entry hasn't got bit 0 set, the SRT entry points to a
+ // closure that's fixed at link-time, and no extra magic is required.
+ if ( (unsigned long)(*srt) & 0x1 ) {
+ evacuate(*stgCast(StgClosure**,(stgCast(unsigned long, *srt) & ~0x1)));
+ } else {
+ evacuate(*p);
+ }
#else
- evacuate(*srt);
+ evacuate(*p);
#endif
+ }
+ p++;
+ bitmap = bitmap >> 1;
}
}
-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_len);
+ scavenge_srt((StgClosure **)thunk_info->srt, 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_len);
+ scavenge_srt((StgClosure **)fun_info->f.srt, 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_len);
+ scavenge_srt((StgClosure **)ret_info->srt, ret_info->i.srt_bitmap);
}
/* -----------------------------------------------------------------------------
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 = ((StgLargeBitmap *)fun_info->f.bitmap)->size;
+ scavenge_large_bitmap(p, (StgLargeBitmap *)fun_info->f.bitmap, 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) {
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, (StgLargeBitmap *)fun_info->f.bitmap, 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) {
q = p;
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.
case WEAK:
case FOREIGN:
case STABLE_NAME:
- case BCO:
{
StgPtr end;
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);
+ p += bco_sizeW(bco);
+ break;
+ }
+
case IND_PERM:
if (stp->gen->no != 0) {
#ifdef PROFILING
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:
{
StgPtr next;
+ // Set the mut_link field to NULL, so that we will put this
+ // array back on the mutable list if it is subsequently thawed
+ // by unsafeThaw#.
+ ((StgMutArrPtrs*)p)->mut_link = NULL;
+
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
(StgClosure *)*p = evacuate((StgClosure *)*p);
case WEAK:
case FOREIGN:
case STABLE_NAME:
- case BCO:
{
StgPtr end;
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);
+ break;
+ }
+
case IND_PERM:
// don't need to do anything here: the only possible case
// is that we're in a 1-space compacting collector, with
{
StgPtr next;
+ // Set the mut_link field to NULL, so that we will put this
+ // array on the mutable list if it is subsequently thawed
+ // by unsafeThaw#.
+ ((StgMutArrPtrs*)p)->mut_link = NULL;
+
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
(StgClosure *)*p = evacuate((StgClosure *)*p);
// follow everything
StgPtr next;
+ // Set the mut_link field to NULL, so that we will put this
+ // array on the mutable list if it is subsequently thawed
+ // by unsafeThaw#.
+ ((StgMutArrPtrs*)p)->mut_link = NULL;
+
next = p + mut_arr_ptrs_sizeW((StgMutArrPtrs*)p);
for (p = (P_)((StgMutArrPtrs *)p)->payload; p < next; p++) {
(StgClosure *)*p = evacuate((StgClosure *)*p);
(StgClosure *)*q = evacuate((StgClosure *)*q);
}
evac_gen = 0;
+ // Set the mut_link field to NULL, so that we will put this
+ // array back on the mutable list if it is subsequently thawed
+ // by unsafeThaw#.
p->mut_link = NULL;
if (failed_to_evac) {
failed_to_evac = rtsFalse;
}
}
-static inline StgPtr
+STATIC_INLINE StgPtr
scavenge_small_bitmap (StgPtr p, nat size, StgWord bitmap)
{
while (size > 0) {
p = scavenge_small_bitmap(p, size, bitmap);
follow_srt:
- scavenge_srt((StgClosure **)info->srt, info->i.srt_len);
+ scavenge_srt((StgClosure **)info->srt, info->i.srt_bitmap);
continue;
case RET_BCO: {
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_SIZE;
+ size = RET_DYN_BITMAP_SIZE;
p = scavenge_small_bitmap(p, size, bitmap);
// skip over the non-ptr words
- p += GET_NONPTRS(dyn);
+ p += RET_DYN_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
// follow the ptr words
- for (size = GET_PTRS(dyn); size > 0; size--) {
+ for (size = RET_DYN_PTRS(dyn); size > 0; size--) {
(StgClosure *)*p = evacuate((StgClosure *)*p);
p++;
}
for (c = (StgIndStatic *)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;
}
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);
// 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;
- sp -= chunk_size;
+ chunk_size = (unsigned char*)gap_end - (unsigned char*)next_gap_start;
+ (unsigned char*)sp -= chunk_size;
memmove(sp, next_gap_start, chunk_size);
}
fputc('\n', stderr);
}
-static inline rtsBool
+STATIC_INLINE rtsBool
maybeLarge(StgClosure *closure)
{
StgInfoTable *info = get_itbl(closure);