[project @ 2002-11-05 14:10:44 by simonpj]

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

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index 6b8bd3d..9ed6f64 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.141 2002/09/10 10:43:52 simonmar Exp $
+ * $Id: GC.c,v 1.145 2002/10/25 09:40:47 simonmar Exp $
  *
  * (c) The GHC Team 1998-1999
  *
@@ -27,6 +27,7 @@
 #include "Prelude.h"
 #include "ParTicky.h"          // ToDo: move into Rts.h
 #include "GCCompact.h"
+#include "Signals.h"
 #if defined(GRAN) || defined(PAR)
 # include "GranSimRts.h"
 # include "ParallelRts.h"
@@ -249,6 +250,11 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
                     Now, Now));
 #endif
 
+#ifndef mingw32_TARGET_OS
+  // block signals
+  blockUserSignals();
+#endif
+
   // tell the stats department that we've started a GC 
   stat_startGC();
 
@@ -1030,6 +1036,11 @@ 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
+  // unblock signals again
+  unblockUserSignals();
+#endif
+
   //PAR_TICKY_TP();
 }
 
@@ -1295,14 +1306,17 @@ isAlive(StgClosure *p)
     if (LOOKS_LIKE_STATIC(p) || bd->gen_no > N) {
        return p;
     }
-    // large objects have an evacuated flag
+
+    // if it's a pointer into to-space, then we're done
+    if (bd->flags & BF_EVACUATED) {
+       return p;
+    }
+
+    // large objects use the evacuated flag
     if (bd->flags & BF_LARGE) {
-       if (bd->flags & BF_EVACUATED) {
-           return p;
-       } else {
-           return NULL;
-       }
+       return NULL;
     }
+
     // check the mark bit for compacted steps
     if (bd->step->is_compacted && is_marked((P_)p,bd)) {
        return p;
@@ -1368,8 +1382,12 @@ addBlock(step *stp)
 static __inline__ void 
 upd_evacuee(StgClosure *p, StgClosure *dest)
 {
-  p->header.info = &stg_EVACUATED_info;
-  ((StgEvacuated *)p)->evacuee = 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;
+    ((StgEvacuated *)p)->evacuee = dest;
 }
 
 
@@ -1971,7 +1989,6 @@ selector_loop:
          return selectee->payload[field];
 
       case IND:
-      case IND_STATIC:
       case IND_PERM:
       case IND_OLDGEN:
       case IND_OLDGEN_PERM:
@@ -1984,6 +2001,11 @@ 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;