X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=rts%2FPrimOps.cmm;h=e17c6fb3f870b7b923c79570cfe45a087bd787ee;hp=4b5e106710cba340c13f92ca6d4b76498d946e7b;hb=e5c3b478b3cd1707cf122833822f44b2ac09b8e9;hpb=624e821201ed68425c906358f8d45a69f4e61093

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 4b5e106..e17c6fb 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1,6 +1,6 @@
 /* -----------------------------------------------------------------------------
  *
- * (c) The GHC Team, 1998-2004
+ * (c) The GHC Team, 1998-2011
  *
  * Out-of-line primitive operations
  *
@@ -34,7 +34,7 @@ import pthread_mutex_unlock;
 import base_ControlziExceptionziBase_nestedAtomically_closure;
 import EnterCriticalSection;
 import LeaveCriticalSection;
-import ghczmprim_GHCziBool_False_closure;
+import ghczmprim_GHCziTypes_False_closure;
 #if !defined(mingw32_HOST_OS)
 import sm_mutex;
 #endif
@@ -64,7 +64,7 @@ stg_newByteArrayzh
     ("ptr" p) = foreign "C" allocate(MyCapability() "ptr",words) [];
     TICK_ALLOC_PRIM(SIZEOF_StgArrWords,WDS(payload_words),0);
     SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
-    StgArrWords_words(p) = payload_words;
+    StgArrWords_bytes(p) = n;
     RET_P(p);
 }
 
@@ -73,10 +73,11 @@ stg_newByteArrayzh
 
 stg_newPinnedByteArrayzh
 {
-    W_ words, bytes, payload_words, p;
+    W_ words, n, bytes, payload_words, p;
 
     MAYBE_GC(NO_PTRS,stg_newPinnedByteArrayzh);
-    bytes = R1;
+    n = R1;
+    bytes = n;
     /* payload_words is what we will tell the profiler we had to allocate */
     payload_words = ROUNDUP_BYTES_TO_WDS(bytes);
     /* When we actually allocate memory, we need to allow space for the
@@ -96,18 +97,25 @@ stg_newPinnedByteArrayzh
     p = p + ((-p - SIZEOF_StgArrWords) & BA_MASK);
 
     SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
-    StgArrWords_words(p) = payload_words;
+    StgArrWords_bytes(p) = n;
     RET_P(p);
 }
 
 stg_newAlignedPinnedByteArrayzh
 {
-    W_ words, bytes, payload_words, p, alignment;
+    W_ words, n, bytes, payload_words, p, alignment;
 
     MAYBE_GC(NO_PTRS,stg_newAlignedPinnedByteArrayzh);
-    bytes = R1;
+    n = R1;
     alignment = R2;
 
+    /* we always supply at least word-aligned memory, so there's no
+       need to allow extra space for alignment if the requirement is less
+       than a word.  This also prevents mischief with alignment == 0. */
+    if (alignment <= SIZEOF_W) { alignment = 1; }
+
+    bytes = n;
+
     /* payload_words is what we will tell the profiler we had to allocate */
     payload_words = ROUNDUP_BYTES_TO_WDS(bytes);
 
@@ -129,7 +137,7 @@ stg_newAlignedPinnedByteArrayzh
     p = p + ((-p - SIZEOF_StgArrWords) & (alignment - 1));
 
     SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
-    StgArrWords_words(p) = payload_words;
+    StgArrWords_bytes(p) = n;
     RET_P(p);
 }
 
@@ -204,6 +212,7 @@ stg_unsafeThawArrayzh
   }
 }
 
+
 /* -----------------------------------------------------------------------------
    MutVar primitives
    -------------------------------------------------------------------------- */
@@ -222,6 +231,25 @@ stg_newMutVarzh
     RET_P(mv);
 }
 
+stg_casMutVarzh
+ /* MutVar# s a -> a -> a -> State# s -> (# State#, Int#, a #) */
+{
+    W_ mv, old, new, h;
+
+    mv  = R1;
+    old = R2;
+    new = R3;
+
+    (h) = foreign "C" cas(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var,
+                          old, new) [];
+    if (h != old) {
+        RET_NP(1,h);
+    } else {
+        RET_NP(0,h);
+    }
+}
+
+
 stg_atomicModifyMutVarzh
 {
     W_ mv, f, z, x, y, r, h;
@@ -378,7 +406,7 @@ stg_mkWeakForeignEnvzh
   TICK_ALLOC_PRIM(SIZEOF_StgArrWords,WDS(payload_words),0);
   SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]);
 
-  StgArrWords_words(p)     = payload_words;
+  StgArrWords_bytes(p)     = WDS(payload_words);
   StgArrWords_payload(p,0) = fptr;
   StgArrWords_payload(p,1) = ptr;
   StgArrWords_payload(p,2) = eptr;
@@ -623,14 +651,9 @@ stg_threadStatuszh
     W_ tso;
     W_ why_blocked;
     W_ what_next;
-    W_ ret;
+    W_ ret, cap, locked;
 
     tso = R1;
-    loop:
-      if (TO_W_(StgTSO_what_next(tso)) == ThreadRelocated) {
-          tso = StgTSO__link(tso);
-          goto loop;
-      }
 
     what_next   = TO_W_(StgTSO_what_next(tso));
     why_blocked = TO_W_(StgTSO_why_blocked(tso));
@@ -648,7 +671,16 @@ stg_threadStatuszh
             ret = why_blocked;
         }
     }
-    RET_N(ret);
+
+    cap = TO_W_(Capability_no(StgTSO_cap(tso)));
+
+    if ((TO_W_(StgTSO_flags(tso)) & TSO_LOCKED) != 0) {
+        locked = 1;
+    } else {
+        locked = 0;
+    }
+
+    RET_NNN(ret,cap,locked);
 }
 
 /* -----------------------------------------------------------------------------
@@ -931,9 +963,9 @@ stg_retryzh
 
   // Find the enclosing ATOMICALLY_FRAME or CATCH_RETRY_FRAME
 retry_pop_stack:
-  StgTSO_sp(CurrentTSO) = Sp;
-  (frame_type) = foreign "C" findRetryFrameHelper(CurrentTSO "ptr") [];
-  Sp = StgTSO_sp(CurrentTSO);
+  SAVE_THREAD_STATE();
+  (frame_type) = foreign "C" findRetryFrameHelper(MyCapability(), CurrentTSO "ptr") [];
+  LOAD_THREAD_STATE();
   frame = Sp;
   trec = StgTSO_trec(CurrentTSO);
   outer  = StgTRecHeader_enclosing_trec(trec);
@@ -1130,17 +1162,21 @@ stg_newMVarzh
 }
 
 
-#define PerformTake(tso, value)				\
-    W_[StgTSO_sp(tso) + WDS(1)] = value;		\
-    W_[StgTSO_sp(tso) + WDS(0)] = stg_gc_unpt_r1_info;
+#define PerformTake(stack, value)               \
+    W_ sp;                                      \
+    sp = StgStack_sp(stack);                    \
+    W_[sp + WDS(1)] = value;                    \
+    W_[sp + WDS(0)] = stg_gc_unpt_r1_info;
 
-#define PerformPut(tso,lval)			\
-    StgTSO_sp(tso) = StgTSO_sp(tso) + WDS(3);	\
-    lval = W_[StgTSO_sp(tso) - WDS(1)];
+#define PerformPut(stack,lval)                  \
+    W_ sp;                                      \
+    sp = StgStack_sp(stack) + WDS(3);           \
+    StgStack_sp(stack) = sp;                    \
+    lval = W_[sp - WDS(1)];
 
 stg_takeMVarzh
 {
-    W_ mvar, val, info, tso;
+    W_ mvar, val, info, tso, q;
 
     /* args: R1 = MVar closure */
     mvar = R1;
@@ -1159,80 +1195,88 @@ stg_takeMVarzh
      * and wait until we're woken up.
      */
     if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
+        
+        // Note [mvar-heap-check] We want to do the heap check in the
+        // branch here, to avoid the conditional in the common case.
+        // However, we've already locked the MVar above, so we better
+        // be careful to unlock it again if the the heap check fails.
+        // Unfortunately we don't have an easy way to inject any code
+        // into the heap check generated by the code generator, so we
+        // have to do it in stg_gc_gen (see HeapStackCheck.cmm).
+        HP_CHK_GEN_TICKY(SIZEOF_StgMVarTSOQueue, R1_PTR, stg_takeMVarzh);
+
+        q = Hp - SIZEOF_StgMVarTSOQueue + WDS(1);
+
+        SET_HDR(q, stg_MVAR_TSO_QUEUE_info, CCS_SYSTEM);
+        StgMVarTSOQueue_link(q) = END_TSO_QUEUE;
+        StgMVarTSOQueue_tso(q)  = CurrentTSO;
+
 	if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
-	    StgMVar_head(mvar) = CurrentTSO;
+	    StgMVar_head(mvar) = q;
 	} else {
-            foreign "C" setTSOLink(MyCapability() "ptr", 
-                                   StgMVar_tail(mvar) "ptr",
-                                   CurrentTSO) [];
+            StgMVarTSOQueue_link(StgMVar_tail(mvar)) = q;
+            foreign "C" recordClosureMutated(MyCapability() "ptr",
+                                             StgMVar_tail(mvar)) [];
 	}
-	StgTSO__link(CurrentTSO)       = stg_END_TSO_QUEUE_closure;
+	StgTSO__link(CurrentTSO)       = q;
 	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;
+	StgMVar_tail(mvar)             = q;
 	
         R1 = mvar;
 	jump stg_block_takemvar;
-  }
-
-  /* we got the value... */
-  val = StgMVar_value(mvar);
-
-  if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure)
-  {
-      /* There are putMVar(s) waiting... 
-       * wake up the first thread on the queue
-       */
-      ASSERT(StgTSO_why_blocked(StgMVar_head(mvar)) == BlockedOnMVar::I16);
-
-      /* actually perform the putMVar for the thread that we just woke up */
-      tso = StgMVar_head(mvar);
-      PerformPut(tso,StgMVar_value(mvar));
-
-      if (TO_W_(StgTSO_dirty(tso)) == 0) {
-          foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
-      }
+    }
+    
+    /* we got the value... */
+    val = StgMVar_value(mvar);
+    
+    q = StgMVar_head(mvar);
+loop:
+    if (q == stg_END_TSO_QUEUE_closure) {
+        /* No further putMVars, MVar is now empty */
+        StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
+        unlockClosure(mvar, stg_MVAR_DIRTY_info);
+        RET_P(val);
+    }
+    if (StgHeader_info(q) == stg_IND_info ||
+        StgHeader_info(q) == stg_MSG_NULL_info) {
+        q = StgInd_indirectee(q);
+        goto loop;
+    }
+    
+    // There are putMVar(s) waiting... wake up the first thread on the queue
+    
+    tso = StgMVarTSOQueue_tso(q);
+    StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
+    if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
+        StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
+    }
 
-      ("ptr" tso) = foreign "C" unblockOne_(MyCapability() "ptr", 
-                                            StgMVar_head(mvar) "ptr", 1) [];
-      StgMVar_head(mvar) = tso;
+    ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16);
+    ASSERT(StgTSO_block_info(tso) == mvar);
 
-      if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
-	  StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
-      }
+    // actually perform the putMVar for the thread that we just woke up
+    W_ stack;
+    stack = StgTSO_stackobj(tso);
+    PerformPut(stack, StgMVar_value(mvar));
 
-#if defined(THREADED_RTS)
-      unlockClosure(mvar, stg_MVAR_DIRTY_info);
-#else
-      SET_INFO(mvar,stg_MVAR_DIRTY_info);
-#endif
-      RET_P(val);
-  } 
-  else
-  {
-      /* No further putMVars, MVar is now empty */
-      StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
- 
-#if defined(THREADED_RTS)
-      unlockClosure(mvar, stg_MVAR_DIRTY_info);
-#else
-      SET_INFO(mvar,stg_MVAR_DIRTY_info);
-#endif
+    // indicate that the MVar operation has now completed.
+    StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
+    
+    // no need to mark the TSO dirty, we have only written END_TSO_QUEUE.
 
-      RET_P(val);
-  }
+    foreign "C" tryWakeupThread(MyCapability() "ptr", tso) [];
+    
+    unlockClosure(mvar, stg_MVAR_DIRTY_info);
+    RET_P(val);
 }
 
 
 stg_tryTakeMVarzh
 {
-    W_ mvar, val, info, tso;
+    W_ mvar, val, info, tso, q;
 
     /* args: R1 = MVar closure */
-
     mvar = R1;
 
 #if defined(THREADED_RTS)
@@ -1240,7 +1284,10 @@ stg_tryTakeMVarzh
 #else
     info = GET_INFO(mvar);
 #endif
-
+        
+    /* If the MVar is empty, put ourselves on its blocking queue,
+     * and wait until we're woken up.
+     */
     if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
 #if defined(THREADED_RTS)
         unlockClosure(mvar, info);
@@ -1250,59 +1297,59 @@ stg_tryTakeMVarzh
 	 */
 	RET_NP(0, stg_NO_FINALIZER_closure);
     }
-
+    
     if (info == stg_MVAR_CLEAN_info) {
-        foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr");
+        foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr") [];
     }
 
     /* we got the value... */
     val = StgMVar_value(mvar);
+    
+    q = StgMVar_head(mvar);
+loop:
+    if (q == stg_END_TSO_QUEUE_closure) {
+        /* No further putMVars, MVar is now empty */
+        StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
+        unlockClosure(mvar, stg_MVAR_DIRTY_info);
+        RET_NP(1, val);
+    }
+    if (StgHeader_info(q) == stg_IND_info ||
+        StgHeader_info(q) == stg_MSG_NULL_info) {
+        q = StgInd_indirectee(q);
+        goto loop;
+    }
+    
+    // There are putMVar(s) waiting... wake up the first thread on the queue
+    
+    tso = StgMVarTSOQueue_tso(q);
+    StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
+    if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
+        StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
+    }
 
-    if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure) {
+    ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16);
+    ASSERT(StgTSO_block_info(tso) == mvar);
 
-	/* There are putMVar(s) waiting... 
-	 * wake up the first thread on the queue
-	 */
-	ASSERT(StgTSO_why_blocked(StgMVar_head(mvar)) == BlockedOnMVar::I16);
+    // actually perform the putMVar for the thread that we just woke up
+    W_ stack;
+    stack = StgTSO_stackobj(tso);
+    PerformPut(stack, StgMVar_value(mvar));
 
-	/* actually perform the putMVar for the thread that we just woke up */
-	tso = StgMVar_head(mvar);
-	PerformPut(tso,StgMVar_value(mvar));
-        if (TO_W_(StgTSO_dirty(tso)) == 0) {
-            foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
-        }
-
-        ("ptr" tso) = foreign "C" unblockOne_(MyCapability() "ptr", 
-                                              StgMVar_head(mvar) "ptr", 1) [];
-	StgMVar_head(mvar) = tso;
+    // indicate that the MVar operation has now completed.
+    StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
+    
+    // no need to mark the TSO dirty, we have only written END_TSO_QUEUE.
 
-	if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
-	    StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
-	}
-#if defined(THREADED_RTS)
-        unlockClosure(mvar, stg_MVAR_DIRTY_info);
-#else
-        SET_INFO(mvar,stg_MVAR_DIRTY_info);
-#endif
-    }
-    else 
-    {
-	/* No further putMVars, MVar is now empty */
-	StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
-#if defined(THREADED_RTS)
-    	unlockClosure(mvar, stg_MVAR_DIRTY_info);
-#else
-	SET_INFO(mvar,stg_MVAR_DIRTY_info);
-#endif
-    }
+    foreign "C" tryWakeupThread(MyCapability() "ptr", tso) [];
     
-    RET_NP(1, val);
+    unlockClosure(mvar, stg_MVAR_DIRTY_info);
+    RET_NP(1,val);
 }
 
 
 stg_putMVarzh
 {
-    W_ mvar, val, info, tso;
+    W_ mvar, val, info, tso, q;
 
     /* args: R1 = MVar, R2 = value */
     mvar = R1;
@@ -1319,84 +1366,95 @@ stg_putMVarzh
     }
 
     if (StgMVar_value(mvar) != stg_END_TSO_QUEUE_closure) {
+
+        // see Note [mvar-heap-check] above
+        HP_CHK_GEN_TICKY(SIZEOF_StgMVarTSOQueue, R1_PTR & R2_PTR, stg_putMVarzh);
+
+        q = Hp - SIZEOF_StgMVarTSOQueue + WDS(1);
+
+        SET_HDR(q, stg_MVAR_TSO_QUEUE_info, CCS_SYSTEM);
+        StgMVarTSOQueue_link(q) = END_TSO_QUEUE;
+        StgMVarTSOQueue_tso(q)  = CurrentTSO;
+
 	if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
-	    StgMVar_head(mvar) = CurrentTSO;
+	    StgMVar_head(mvar) = q;
 	} else {
-            foreign "C" setTSOLink(MyCapability() "ptr", 
-                                   StgMVar_tail(mvar) "ptr",
-                                   CurrentTSO) [];
+            StgMVarTSOQueue_link(StgMVar_tail(mvar)) = q;
+            foreign "C" recordClosureMutated(MyCapability() "ptr",
+                                             StgMVar_tail(mvar)) [];
 	}
-	StgTSO__link(CurrentTSO)       = stg_END_TSO_QUEUE_closure;
+	StgTSO__link(CurrentTSO)       = q;
 	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;
-	
+	StgMVar_tail(mvar)             = q;
+
         R1 = mvar;
         R2 = val;
 	jump stg_block_putmvar;
     }
   
-    if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure) {
+    q = StgMVar_head(mvar);
+loop:
+    if (q == stg_END_TSO_QUEUE_closure) {
+	/* No further takes, the MVar is now full. */
+	StgMVar_value(mvar) = val;
+    	unlockClosure(mvar, stg_MVAR_DIRTY_info);
+	jump %ENTRY_CODE(Sp(0));
+    }
+    if (StgHeader_info(q) == stg_IND_info ||
+        StgHeader_info(q) == stg_MSG_NULL_info) {
+        q = StgInd_indirectee(q);
+        goto loop;
+    }
 
-	/* There are takeMVar(s) waiting: wake up the first one
-	 */
-	ASSERT(StgTSO_why_blocked(StgMVar_head(mvar)) == BlockedOnMVar::I16);
+    // There are takeMVar(s) waiting: wake up the first one
+    
+    tso = StgMVarTSOQueue_tso(q);
+    StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
+    if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
+        StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
+    }
 
-	/* actually perform the takeMVar */
-	tso = StgMVar_head(mvar);
-	PerformTake(tso, val);
-        if (TO_W_(StgTSO_dirty(tso)) == 0) {
-            foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
-        }
-      
-        ("ptr" tso) = foreign "C" unblockOne_(MyCapability() "ptr", 
-                                              StgMVar_head(mvar) "ptr", 1) [];
-	StgMVar_head(mvar) = tso;
+    ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16);
+    ASSERT(StgTSO_block_info(tso) == mvar);
 
-	if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
-	    StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
-	}
+    // actually perform the takeMVar
+    W_ stack;
+    stack = StgTSO_stackobj(tso);
+    PerformTake(stack, val);
 
-#if defined(THREADED_RTS)
-    	unlockClosure(mvar, stg_MVAR_DIRTY_info);
-#else
-        SET_INFO(mvar,stg_MVAR_DIRTY_info);
-#endif
-	jump %ENTRY_CODE(Sp(0));
-    }
-    else
-    {
-	/* No further takes, the MVar is now full. */
-	StgMVar_value(mvar) = val;
+    // indicate that the MVar operation has now completed.
+    StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
 
-#if defined(THREADED_RTS)
-    	unlockClosure(mvar, stg_MVAR_DIRTY_info);
-#else
-	SET_INFO(mvar,stg_MVAR_DIRTY_info);
-#endif
-	jump %ENTRY_CODE(Sp(0));
+    if (TO_W_(StgStack_dirty(stack)) == 0) {
+        foreign "C" dirty_STACK(MyCapability() "ptr", stack "ptr") [];
     }
     
-    /* ToDo: yield afterward for better communication performance? */
+    foreign "C" tryWakeupThread(MyCapability() "ptr", tso) [];
+
+    unlockClosure(mvar, stg_MVAR_DIRTY_info);
+    jump %ENTRY_CODE(Sp(0));
 }
 
 
 stg_tryPutMVarzh
 {
-    W_ mvar, info, tso;
+    W_ mvar, val, info, tso, q;
 
     /* args: R1 = MVar, R2 = value */
     mvar = R1;
+    val  = R2;
 
 #if defined(THREADED_RTS)
-    ("ptr" info) = foreign "C" lockClosure(mvar "ptr") [R2];
+    ("ptr" info) = foreign "C" lockClosure(mvar "ptr") [];
 #else
     info = GET_INFO(mvar);
 #endif
 
+    if (info == stg_MVAR_CLEAN_info) {
+        foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr");
+    }
+
     if (StgMVar_value(mvar) != stg_END_TSO_QUEUE_closure) {
 #if defined(THREADED_RTS)
     	unlockClosure(mvar, info);
@@ -1404,51 +1462,47 @@ stg_tryPutMVarzh
 	RET_N(0);
     }
   
-    if (info == stg_MVAR_CLEAN_info) {
-        foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr");
+    q = StgMVar_head(mvar);
+loop:
+    if (q == stg_END_TSO_QUEUE_closure) {
+	/* No further takes, the MVar is now full. */
+	StgMVar_value(mvar) = val;
+    	unlockClosure(mvar, stg_MVAR_DIRTY_info);
+        RET_N(1);
+    }
+    if (StgHeader_info(q) == stg_IND_info ||
+        StgHeader_info(q) == stg_MSG_NULL_info) {
+        q = StgInd_indirectee(q);
+        goto loop;
     }
 
-    if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure) {
+    // There are takeMVar(s) waiting: wake up the first one
+    
+    tso = StgMVarTSOQueue_tso(q);
+    StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
+    if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
+        StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
+    }
 
-	/* There are takeMVar(s) waiting: wake up the first one
-	 */
-	ASSERT(StgTSO_why_blocked(StgMVar_head(mvar)) == BlockedOnMVar::I16);
-	
-	/* actually perform the takeMVar */
-	tso = StgMVar_head(mvar);
-	PerformTake(tso, R2);
-        if (TO_W_(StgTSO_dirty(tso)) == 0) {
-            foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
-        }
-      
-        ("ptr" tso) = foreign "C" unblockOne_(MyCapability() "ptr", 
-                                              StgMVar_head(mvar) "ptr", 1) [];
-	StgMVar_head(mvar) = tso;
+    ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16);
+    ASSERT(StgTSO_block_info(tso) == mvar);
 
-	if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
-	    StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
-	}
+    // actually perform the takeMVar
+    W_ stack;
+    stack = StgTSO_stackobj(tso);
+    PerformTake(stack, val);
 
-#if defined(THREADED_RTS)
-    	unlockClosure(mvar, stg_MVAR_DIRTY_info);
-#else
-        SET_INFO(mvar,stg_MVAR_DIRTY_info);
-#endif
-    }
-    else
-    {
-	/* No further takes, the MVar is now full. */
-	StgMVar_value(mvar) = R2;
-
-#if defined(THREADED_RTS)
-    	unlockClosure(mvar, stg_MVAR_DIRTY_info);
-#else
-	SET_INFO(mvar,stg_MVAR_DIRTY_info);
-#endif
+    // indicate that the MVar operation has now completed.
+    StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
+    
+    if (TO_W_(StgStack_dirty(stack)) == 0) {
+        foreign "C" dirty_STACK(MyCapability() "ptr", stack "ptr") [];
     }
     
+    foreign "C" tryWakeupThread(MyCapability() "ptr", tso) [];
+
+    unlockClosure(mvar, stg_MVAR_DIRTY_info);
     RET_N(1);
-    /* ToDo: yield afterward for better communication performance? */
 }
 
 
@@ -1514,7 +1568,7 @@ stg_newBCOzh
     
     bitmap_arr = R5;
 
-    words = BYTES_TO_WDS(SIZEOF_StgBCO) + StgArrWords_words(bitmap_arr);
+    words = BYTES_TO_WDS(SIZEOF_StgBCO) + BYTE_ARR_WDS(bitmap_arr);
     bytes = WDS(words);
 
     ALLOC_PRIM( bytes, R1_PTR&R2_PTR&R3_PTR&R5_PTR, stg_newBCOzh );
@@ -1532,7 +1586,7 @@ stg_newBCOzh
     W_ i;
     i = 0;
 for:
-    if (i < StgArrWords_words(bitmap_arr)) {
+    if (i < BYTE_ARR_WDS(bitmap_arr)) {
 	StgBCO_bitmap(bco,i) = StgArrWords_payload(bitmap_arr,i);
 	i = i + 1;
 	goto for;
@@ -1626,7 +1680,7 @@ for:
        is promoted. */
     
     SET_HDR(nptrs_arr, stg_ARR_WORDS_info, W_[CCCS]);
-    StgArrWords_words(nptrs_arr) = nptrs;
+    StgArrWords_bytes(nptrs_arr) = WDS(nptrs);
     p = 0;
 for2:
     if(p < nptrs) {
@@ -1972,17 +2026,28 @@ stg_getSparkzh
    W_ spark;
 
 #ifndef THREADED_RTS
-   RET_NP(0,ghczmprim_GHCziBool_False_closure);
+   RET_NP(0,ghczmprim_GHCziTypes_False_closure);
 #else
    (spark) = foreign "C" findSpark(MyCapability());
    if (spark != 0) {
       RET_NP(1,spark);
    } else {
-      RET_NP(0,ghczmprim_GHCziBool_False_closure);
+      RET_NP(0,ghczmprim_GHCziTypes_False_closure);
    }
 #endif
 }
 
+stg_numSparkszh
+{
+  W_ n;
+#ifdef THREADED_RTS
+  (n) = foreign "C" dequeElements(Capability_sparks(MyCapability()));
+#else
+  n = 0;
+#endif
+  RET_N(n);
+}
+
 stg_traceEventzh
 {
    W_ msg;
@@ -1999,7 +2064,20 @@ stg_traceEventzh
    // We should go through the macro HASKELLEVENT_USER_MSG_ENABLED from
    // RtsProbes.h, but that header file includes unistd.h, which doesn't
    // work in Cmm
+#if !defined(solaris2_TARGET_OS)
    (enabled) = foreign "C" __dtrace_isenabled$HaskellEvent$user__msg$v1() [];
+#else
+   // Solaris' DTrace can't handle the
+   //     __dtrace_isenabled$HaskellEvent$user__msg$v1
+   // call above. This call is just for testing whether the user__msg
+   // probe is enabled, and is here for just performance optimization.
+   // Since preparation for the probe is not that complex I disable usage of
+   // this test above for Solaris and enable the probe usage manually
+   // here. Please note that this does not mean that the probe will be
+   // used during the runtime! You still need to enable it by consumption
+   // in your dtrace script as you do with any other probe.
+   enabled = 1;
+#endif
    if (enabled != 0) {
      foreign "C" dtraceUserMsgWrapper(MyCapability() "ptr", msg "ptr") [];
    }