/* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.149 2003/03/24 14:46:53 simonmar Exp $
+ * $Id: GC.c,v 1.156 2003/06/19 12:47:08 simonmar Exp $
*
* (c) The GHC Team 1998-2003
*
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
+static StgClosure * evacuate (StgClosure *q) __attribute__((regparm(1)));
+#else
+static StgClosure * evacuate (StgClosure *q);
+#endif
+
static void zero_static_object_list ( StgClosure* first_static );
static void zero_mutable_list ( StgMutClosure *first );
Now, Now));
#endif
-#ifndef mingw32_TARGET_OS
+#if defined(RTS_USER_SIGNALS)
// block signals
blockUserSignals();
#endif
// 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
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 *
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;
}
}
selector_loop:
- if (Bdescr((StgPtr)selectee)->flags & BF_EVACUATED) {
- SET_INFO(p, info_ptr);
- return NULL;
+ // 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:
+ //
+ // - 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).
+ //
+ // So we use the block-descriptor test to find out if we're in
+ // to-space.
+ //
+ if (HEAP_ALLOCED(selectee) &&
+ Bdescr((StgPtr)selectee)->flags & BF_EVACUATED) {
+ goto bale_out;
}
info = get_itbl(selectee);
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];
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;
(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 = 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)
+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;
}
}
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
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->srt, fun_info->i.srt_bitmap);
}
static inline void
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);
}
/* -----------------------------------------------------------------------------
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.
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: {
// traverse the bitmap first
bitmap = GET_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 += GET_NONPTRS(dyn) + RET_DYN_NONPTR_REGS_SIZE;
// follow the ptr words
for (size = GET_PTRS(dyn); size > 0; size--) {
projects / ghc-hetmet.git / blobdiff