Add a proper write barrier for MVars

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

diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index dce83ed..54fe9a4 100644 (file)
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -4,6 +4,11 @@
  *
  * Generational garbage collector: scavenging functions
  *
+ * Documentation on the architecture of the Garbage Collector can be
+ * found in the online commentary:
+ * 
+ *   http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/GC
+ *
  * ---------------------------------------------------------------------------*/
 
 #include "Rts.h"
@@ -72,7 +77,7 @@ scavenge_srt (StgClosure **srt, nat srt_bitmap)
 
   while (bitmap != 0) {
       if ((bitmap & 1) != 0) {
-#ifdef ENABLE_WIN32_DLL_SUPPORT
+#if defined(__PIC__) && defined(mingw32_TARGET_OS)
          // Special-case to handle references to closures hiding out in DLLs, since
          // double indirections required to get at those. The code generator knows
          // which is which when generating the SRT, so it stores the (indirect)
@@ -195,7 +200,7 @@ scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
     StgWord bitmap;
     StgFunInfoTable *fun_info;
     
-    fun_info = get_fun_itbl(fun);
+    fun_info = get_fun_itbl(UNTAG_CLOSURE(fun));
     ASSERT(fun_info->i.type != PAP);
     p = (StgPtr)payload;
 
@@ -288,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;
     }
@@ -406,7 +419,6 @@ scavenge(step *stp)
        bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
        bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
        bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
-       bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls);
        p += bco_sizeW(bco);
        break;
     }
@@ -692,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);
@@ -787,7 +807,6 @@ linear_scan:
            bco->instrs = (StgArrWords *)evacuate((StgClosure *)bco->instrs);
            bco->literals = (StgArrWords *)evacuate((StgClosure *)bco->literals);
            bco->ptrs = (StgMutArrPtrs *)evacuate((StgClosure *)bco->ptrs);
-           bco->itbls = (StgArrWords *)evacuate((StgClosure *)bco->itbls);
            break;
        }
 
@@ -1071,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;
     }
 
@@ -1406,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;
            }
@@ -1646,7 +1677,6 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
     case STOP_FRAME:
     case CATCH_FRAME:
     case RET_SMALL:
-    case RET_VEC_SMALL:
        bitmap = BITMAP_BITS(info->i.layout.bitmap);
        size   = BITMAP_SIZE(info->i.layout.bitmap);
        // NOTE: the payload starts immediately after the info-ptr, we
@@ -1675,7 +1705,6 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
 
       // large bitmap (> 32 entries, or > 64 on a 64-bit machine) 
     case RET_BIG:
-    case RET_VEC_BIG:
     {
        nat size;
 
@@ -1719,7 +1748,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
        StgFunInfoTable *fun_info;
 
        ret_fun->fun = evacuate(ret_fun->fun);
-       fun_info = get_fun_itbl(ret_fun->fun);
+       fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
        p = scavenge_arg_block(fun_info, ret_fun->payload);
        goto follow_srt;
     }