Add a proper write barrier for MVars

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

diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 6e862f2..cd840dd 100644 (file)
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -115,6 +115,8 @@ initStorage( void )
       return;
   }
 
+  initMBlocks();
+
   /* Sanity check to make sure the LOOKS_LIKE_ macros appear to be
    * doing something reasonable.
    */
@@ -779,12 +781,15 @@ allocatePinned( nat n )
 }
 
 /* -----------------------------------------------------------------------------
+   Write Barriers
+   -------------------------------------------------------------------------- */
+
+/*
    This is the write barrier for MUT_VARs, a.k.a. IORefs.  A
    MUT_VAR_CLEAN object is not on the mutable list; a MUT_VAR_DIRTY
    is.  When written to, a MUT_VAR_CLEAN turns into a MUT_VAR_DIRTY
    and is put on the mutable list.
-   -------------------------------------------------------------------------- */
-
+*/
 void
 dirty_MUT_VAR(StgRegTable *reg, StgClosure *p)
 {
@@ -797,6 +802,23 @@ dirty_MUT_VAR(StgRegTable *reg, StgClosure *p)
     }
 }
 
+/*
+   This is the write barrier for MVARs.  An MVAR_CLEAN objects is not
+   on the mutable list; a MVAR_DIRTY is.  When written to, a
+   MVAR_CLEAN turns into a MVAR_DIRTY and is put on the mutable list.
+   The check for MVAR_CLEAN is inlined at the call site for speed,
+   this really does make a difference on concurrency-heavy benchmarks
+   such as Chaneneos and cheap-concurrency.
+*/
+void
+dirty_MVAR(StgRegTable *reg, StgClosure *p)
+{
+    Capability *cap = regTableToCapability(reg);
+    bdescr *bd;
+    bd = Bdescr((StgPtr)p);
+    if (bd->gen_no > 0) recordMutableCap(p,cap,bd->gen_no);
+}
+
 /* -----------------------------------------------------------------------------
    Allocation functions for GMP.
 
@@ -1046,13 +1068,17 @@ void freeExec (void *addr)
     bd->gen_no -= *(StgPtr)p;
     *(StgPtr)p = 0;
 
-    // Free the block if it is empty, but not if it is the block at
-    // the head of the queue.
-    if (bd->gen_no == 0 && bd != exec_block) {
-       debugTrace(DEBUG_gc, "free exec block %p", bd->start);
-        dbl_link_remove(bd, &exec_block);
-       setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsFalse);
-       freeGroup(bd);
+    if (bd->gen_no == 0) {
+        // Free the block if it is empty, but not if it is the block at
+        // the head of the queue.
+        if (bd != exec_block) {
+            debugTrace(DEBUG_gc, "free exec block %p", bd->start);
+            dbl_link_remove(bd, &exec_block);
+            setExecutable(bd->start, bd->blocks * BLOCK_SIZE, rtsFalse);
+            freeGroup(bd);
+        } else {
+            bd->free = bd->start;
+        }
     }
 
     RELEASE_SM_LOCK