[project @ 2003-04-22 16:25:08 by simonmar]

[ghc-hetmet.git] / ghc / rts / GC.c

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 2b30d67..1c11938 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.149 2003/03/24 14:46:53 simonmar Exp $
+ * $Id: GC.c,v 1.154 2003/04/22 16:25:09 simonmar Exp $
  *
  * (c) The GHC Team 1998-2003
  *
@@ -139,7 +139,14 @@ static lnat thunk_selector_depth = 0;
 
 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 );
 
@@ -303,7 +310,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
                     Now, Now));
 #endif
 
-#ifndef mingw32_TARGET_OS
+#if defined(RTS_USER_SIGNALS)
   // block signals
   blockUserSignals();
 #endif
@@ -1080,7 +1087,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
   // 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
@@ -2002,9 +2009,23 @@ eval_thunk_selector( nat field, StgSelector * p )
 
 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);
@@ -2021,12 +2042,15 @@ selector_loop:
          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;
 
@@ -2036,11 +2060,6 @@ 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;
@@ -2113,6 +2132,7 @@ selector_loop:
             (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;
@@ -3669,11 +3689,11 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
        // 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--) {