FIX #2197: an update frame might point to an IND_OLDGEN

[ghc-hetmet.git] / rts / sm / Scav.c

diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 00faff1..0fe7a7f 100644 (file)
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -293,15 +293,23 @@ scavenge(step *stp)
     q = p;
     switch (info->type) {
 
-    case MVAR:
+    case MVAR_CLEAN:
+    case MVAR_DIRTY:
     { 
+       rtsBool saved_eager_promotion = eager_promotion;
+
        StgMVar *mvar = ((StgMVar *)p);
-       evac_gen = 0;
+       eager_promotion = rtsFalse;
        mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
        mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
        mvar->value = evacuate((StgClosure *)mvar->value);
-       evac_gen = saved_evac_gen;
-       failed_to_evac = rtsTrue; // mutable.
+       eager_promotion = saved_eager_promotion;
+
+       if (failed_to_evac) {
+           mvar->header.info = &stg_MVAR_DIRTY_info;
+       } else {
+           mvar->header.info = &stg_MVAR_CLEAN_info;
+       }
        p += sizeofW(StgMVar);
        break;
     }
@@ -696,17 +704,25 @@ linear_scan:
        q = p;
        switch (info->type) {
            
-       case MVAR:
-       {
-           StgMVar *mvar = ((StgMVar *)p);
-           evac_gen = 0;
-           mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
-           mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
-           mvar->value = evacuate((StgClosure *)mvar->value);
-           evac_gen = saved_evac_gen;
-           failed_to_evac = rtsTrue; // mutable.
-           break;
-       }
+        case MVAR_CLEAN:
+        case MVAR_DIRTY:
+        { 
+            rtsBool saved_eager_promotion = eager_promotion;
+            
+            StgMVar *mvar = ((StgMVar *)p);
+            eager_promotion = rtsFalse;
+            mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
+            mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
+            mvar->value = evacuate((StgClosure *)mvar->value);
+            eager_promotion = saved_eager_promotion;
+            
+            if (failed_to_evac) {
+                mvar->header.info = &stg_MVAR_DIRTY_info;
+            } else {
+                mvar->header.info = &stg_MVAR_CLEAN_info;
+            }
+            break;
+        }
 
        case FUN_2_0:
            scavenge_fun_srt(info);
@@ -1074,15 +1090,23 @@ scavenge_one(StgPtr p)
     
     switch (info->type) {
        
-    case MVAR:
+    case MVAR_CLEAN:
+    case MVAR_DIRTY:
     { 
+       rtsBool saved_eager_promotion = eager_promotion;
+
        StgMVar *mvar = ((StgMVar *)p);
-       evac_gen = 0;
+       eager_promotion = rtsFalse;
        mvar->head = (StgTSO *)evacuate((StgClosure *)mvar->head);
        mvar->tail = (StgTSO *)evacuate((StgClosure *)mvar->tail);
        mvar->value = evacuate((StgClosure *)mvar->value);
-       evac_gen = saved_evac_gen;
-       failed_to_evac = rtsTrue; // mutable.
+       eager_promotion = saved_eager_promotion;
+
+       if (failed_to_evac) {
+           mvar->header.info = &stg_MVAR_DIRTY_info;
+       } else {
+           mvar->header.info = &stg_MVAR_CLEAN_info;
+       }
        break;
     }
 
@@ -1409,6 +1433,10 @@ scavenge_mutable_list(generation *gen)
            case MUT_ARR_PTRS_FROZEN:
            case MUT_ARR_PTRS_FROZEN0:
                mutlist_MUTARRS++; break;
+           case MVAR_CLEAN:
+               barf("MVAR_CLEAN on mutable list");
+           case MVAR_DIRTY:
+               mutlist_MVARS++; break;
            default:
                mutlist_OTHERS++; break;
            }
@@ -1633,14 +1661,21 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
        // the indirection into an IND_PERM, so that evacuate will
        // copy the indirection into the old generation instead of
        // discarding it.
-       if (get_itbl(((StgUpdateFrame *)p)->updatee)->type == IND) {
+    {
+        nat type;
+        type = get_itbl(((StgUpdateFrame *)p)->updatee)->type;
+       if (type == IND) {
            ((StgUpdateFrame *)p)->updatee->header.info = 
                (StgInfoTable *)&stg_IND_PERM_info;
-       }
+       } else if (type == IND_OLDGEN) {
+           ((StgUpdateFrame *)p)->updatee->header.info = 
+               (StgInfoTable *)&stg_IND_OLDGEN_PERM_info;
+        }            
        ((StgUpdateFrame *)p)->updatee 
            = evacuate(((StgUpdateFrame *)p)->updatee);
        p += sizeofW(StgUpdateFrame);
        continue;
+    }
 
       // small bitmap (< 32 entries, or 64 on a 64-bit machine) 
     case CATCH_STM_FRAME: