White space only

[ghc-hetmet.git] / rts / PrimOps.cmm

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 40948a3..a6e221b 100644 (file)
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1651,8 +1651,11 @@ takeMVarzh_fast
                                    CurrentTSO) [];
        }
        StgTSO__link(CurrentTSO)       = stg_END_TSO_QUEUE_closure;
-       StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
        StgTSO_block_info(CurrentTSO)  = mvar;
+        // write barrier for throwTo(), which looks at block_info
+        // if why_blocked==BlockedOnMVar.
+        prim %write_barrier() [];
+       StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
        StgMVar_tail(mvar) = CurrentTSO;
        
         R1 = mvar;
@@ -1808,8 +1811,11 @@ putMVarzh_fast
                                    CurrentTSO) [];
        }
        StgTSO__link(CurrentTSO)       = stg_END_TSO_QUEUE_closure;
-       StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
        StgTSO_block_info(CurrentTSO)  = mvar;
+        // write barrier for throwTo(), which looks at block_info
+        // if why_blocked==BlockedOnMVar.
+        prim %write_barrier() [];
+       StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
        StgMVar_tail(mvar) = CurrentTSO;
        
         R1 = mvar;
@@ -2356,6 +2362,26 @@ getApStackValzh_fast
    RET_NP(ok,val);
 }
 
+/* -----------------------------------------------------------------------------
+   Misc. primitives
+   -------------------------------------------------------------------------- */
+
+// Write the cost center stack of the first argument on stderr; return
+// the second.  Possibly only makes sense for already evaluated
+// things?
+traceCcszh_fast
+{
+    W_ ccs;
+
+#ifdef PROFILING
+    ccs = StgHeader_ccs(UNTAG(R1));
+    foreign "C" fprintCCS_stderr(ccs "ptr") [R2];
+#endif
+
+    R1 = R2;
+    ENTER();
+}
+
 getSparkzh_fast
 {
    W_ spark;