[project @ 2003-11-26 12:14:26 by simonmar]

Fix a rare bug in compacting GC, related to eval_thunk_selector().  This
might be the cause of the "Closure type 0" bug in SourceForge.

diff --git a/ghc/includes/Block.h b/ghc/includes/Block.h
index 15c9cf0..ac30e8c 100644 (file)
--- a/ghc/includes/Block.h
+++ b/ghc/includes/Block.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Block.h,v 1.15 2003/11/12 17:27:00 sof Exp $
+ * $Id: Block.h,v 1.16 2003/11/26 12:14:26 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -76,9 +76,14 @@ typedef struct _bdescr {
 #define BDESCR_SHIFT 5
 #endif
 
+// Block contains objects evacuated during this GC
 #define BF_EVACUATED 1
+// Block is a large object
 #define BF_LARGE     2
+// Block is pinned
 #define BF_PINNED    4
+// Block is part of a compacted generation
+#define BF_COMPACTED 8
 
 /* Finding the block descriptor for a given block -------------------------- */
 

diff --git a/ghc/rts/GC.c b/ghc/rts/GC.c
index fbc4946..6fa5416 100644 (file)
--- a/ghc/rts/GC.c
+++ b/ghc/rts/GC.c
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: GC.c,v 1.163 2003/11/12 17:49:07 sof Exp $
+ * $Id: GC.c,v 1.164 2003/11/26 12:14:26 simonmar Exp $
  *
  * (c) The GHC Team 1998-2003
  *
@@ -752,6 +752,7 @@ GarbageCollect ( void (*get_roots)(evac_fn), rtsBool force_major_gc )
                // 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_COMPACTED;  // compacted next time
                }
                // tack the new blocks on the end of the existing blocks
                if (stp->blocks == NULL) {
@@ -1375,7 +1376,7 @@ isAlive(StgClosure *p)
     }
 
     // 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;
     }
 
@@ -1700,7 +1701,7 @@ loop:
     /* 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()) {
@@ -2017,6 +2018,7 @@ eval_thunk_selector( nat field, StgSelector * p )
     StgInfoTable *info;
     const StgInfoTable *info_ptr;
     StgClosure *selectee;
+    bdescr *bd;
     
     selectee = p->selectee;
 
@@ -2043,17 +2045,32 @@ selector_loop:
     // eval_thunk_selector().  There are various ways this could
     // happen:
     //
-    // - following an IND_STATIC
+    // 1. 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).
+    // 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).
     // 
-    // So we use the block-descriptor test to find out if we're in
-    // to-space.
+    // 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.
+    //
+    bd = Bdescr((StgPtr)selectee);
     if (HEAP_ALLOCED(selectee) &&
-       Bdescr((StgPtr)selectee)->flags & BF_EVACUATED) {
+       ((bd->flags & BF_EVACUATED) 
+        || ((bd->flags & BF_COMPACTED) &&
+            bd->gen_no <= N &&
+            is_marked((P_)selectee,bd)))) {
        goto bale_out;
     }