[project @ 2002-09-25 14:46:31 by simonmar]

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

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index cfa23c1..853d548 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.140 2002/09/06 09:56:12 simonmar Exp $
+ * $Id: GC.c,v 1.144 2002/09/25 14:46:34 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"
@@ -130,7 +131,7 @@ static lnat g0s0_pcnt_kept = 30; // percentage of g0s0 live at last minor GC
 /* Used to avoid long recursion due to selector thunks
  */
 static lnat thunk_selector_depth = 0;
-#define MAX_THUNK_SELECTOR_DEPTH 256
+#define MAX_THUNK_SELECTOR_DEPTH 8
 
 /* -----------------------------------------------------------------------------
    Static function declarations
@@ -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;
@@ -1916,7 +1930,10 @@ loop:
    Evaluate a THUNK_SELECTOR if possible.
 
    returns: NULL if we couldn't evaluate this THUNK_SELECTOR, or
-   a closure pointer if we evaluated it and this is the result
+   a closure pointer if we evaluated it and this is the result.  Note
+   that "evaluating" the THUNK_SELECTOR doesn't necessarily mean
+   reducing it to HNF, just that we have eliminated the selection.
+   The result might be another thunk, or even another THUNK_SELECTOR.
 
    If the return value is non-NULL, the original selector thunk has
    been BLACKHOLE'd, and should be updated with an indirection or a
@@ -1930,18 +1947,27 @@ eval_thunk_selector( nat field, StgSelector * p )
     StgInfoTable *info;
     const StgInfoTable *info_ptr;
     StgClosure *selectee;
-
+    
     selectee = p->selectee;
 
     // Save the real info pointer (NOTE: not the same as get_itbl()).
     info_ptr = p->header.info;
 
+    // If the THUNK_SELECTOR is in a generation that we are not
+    // collecting, then bail out early.  We won't be able to save any
+    // space in any case, and updating with an indirection is trickier
+    // in an old gen.
+    if (Bdescr((StgPtr)p)->gen_no > N) {
+       return NULL;
+    }
+
     // BLACKHOLE the selector thunk, since it is now under evaluation.
     // This is important to stop us going into an infinite loop if
     // this selector thunk eventually refers to itself.
     SET_INFO(p,&stg_BLACKHOLE_info);
 
 selector_loop:
+
     info = get_itbl(selectee);
     switch (info->type) {
       case CONSTR:
@@ -1991,9 +2017,13 @@ selector_loop:
          if (val == NULL) { 
              break;
          } else {
-             // we evaluated this selector thunk, so update it with
-             // an indirection.
-             UPD_IND_NOLOCK(selectee, val);
+             // We evaluated this selector thunk, so update it with
+             // an indirection.  NOTE: we don't use UPD_IND here,
+             // 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.
+             ((StgInd *)selectee)->indirectee = val;
+             SET_INFO(selectee,&stg_IND_info);
              selectee = val;
              goto selector_loop;
          }