Fix Haddock errors.

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

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index c7c3727..53de724 100644 (file)
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1034,6 +1034,39 @@ isCurrentThreadBoundzh_fast
   RET_N(r);
 }
 
+threadStatuszh_fast
+{
+    /* args: R1 :: ThreadId# */
+    W_ tso;
+    W_ why_blocked;
+    W_ what_next;
+    W_ ret;
+
+    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));
+    // Note: these two reads are not atomic, so they might end up
+    // being inconsistent.  It doesn't matter, since we
+    // only return one or the other.  If we wanted to return the
+    // contents of block_info too, then we'd have to do some synchronisation.
+
+    if (what_next == ThreadComplete) {
+        ret = 16;  // NB. magic, matches up with GHC.Conc.threadStatus
+    } else {
+        if (what_next == ThreadKilled) {
+            ret = 17;
+        } else {
+            ret = why_blocked;
+        }
+    }
+    RET_N(ret);
+}
 
 /* -----------------------------------------------------------------------------
  * TVar primitives
@@ -1551,7 +1584,7 @@ takeMVarzh_fast
 #endif
         
     if (info == stg_MVAR_CLEAN_info) {
-        foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr");
+        foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr") [];
     }
 
     /* If the MVar is empty, put ourselves on its blocking queue,
@@ -1561,13 +1594,16 @@ takeMVarzh_fast
        if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
            StgMVar_head(mvar) = CurrentTSO;
        } else {
-           StgTSO_link(StgMVar_tail(mvar)) = CurrentTSO;
+            foreign "C" setTSOLink(MyCapability() "ptr", 
+                                   StgMVar_tail(mvar) "ptr",
+                                   CurrentTSO) [];
        }
-       StgTSO_link(CurrentTSO)        = stg_END_TSO_QUEUE_closure;
+       StgTSO__link(CurrentTSO)       = stg_END_TSO_QUEUE_closure;
        StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
        StgTSO_block_info(CurrentTSO)  = mvar;
        StgMVar_tail(mvar) = CurrentTSO;
        
+        R1 = mvar;
        jump stg_block_takemvar;
   }
 
@@ -1584,17 +1620,14 @@ takeMVarzh_fast
       /* actually perform the putMVar for the thread that we just woke up */
       tso = StgMVar_head(mvar);
       PerformPut(tso,StgMVar_value(mvar));
-      dirtyTSO(tso);
 
-#if defined(GRAN) || defined(PAR)
-      /* ToDo: check 2nd arg (mvar) is right */
-      ("ptr" tso) = foreign "C" unblockOne(StgMVar_head(mvar),mvar) [];
-      StgMVar_head(mvar) = tso;
-#else
-      ("ptr" tso) = foreign "C" unblockOne(MyCapability() "ptr", 
-                                        StgMVar_head(mvar) "ptr") [];
+      if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 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;
-#endif
 
       if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
          StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
@@ -1664,17 +1697,13 @@ tryTakeMVarzh_fast
        /* actually perform the putMVar for the thread that we just woke up */
        tso = StgMVar_head(mvar);
        PerformPut(tso,StgMVar_value(mvar));
-        dirtyTSO(tso);
+        if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+            foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
+        }
 
-#if defined(GRAN) || defined(PAR)
-       /* ToDo: check 2nd arg (mvar) is right */
-       ("ptr" tso) = foreign "C" unblockOne(StgMVar_head(mvar) "ptr", mvar "ptr") [];
-       StgMVar_head(mvar) = tso;
-#else
-       ("ptr" tso) = foreign "C" unblockOne(MyCapability() "ptr",
-                                          StgMVar_head(mvar) "ptr") [];
+        ("ptr" tso) = foreign "C" unblockOne_(MyCapability() "ptr", 
+                                              StgMVar_head(mvar) "ptr", 1) [];
        StgMVar_head(mvar) = tso;
-#endif
 
        if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
            StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
@@ -1702,13 +1731,14 @@ tryTakeMVarzh_fast
 
 putMVarzh_fast
 {
-    W_ mvar, info, tso;
+    W_ mvar, val, info, tso;
 
     /* 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
@@ -1721,13 +1751,17 @@ putMVarzh_fast
        if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
            StgMVar_head(mvar) = CurrentTSO;
        } else {
-           StgTSO_link(StgMVar_tail(mvar)) = CurrentTSO;
+            foreign "C" setTSOLink(MyCapability() "ptr", 
+                                   StgMVar_tail(mvar) "ptr",
+                                   CurrentTSO) [];
        }
-       StgTSO_link(CurrentTSO)        = stg_END_TSO_QUEUE_closure;
+       StgTSO__link(CurrentTSO)       = stg_END_TSO_QUEUE_closure;
        StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
        StgTSO_block_info(CurrentTSO)  = mvar;
        StgMVar_tail(mvar) = CurrentTSO;
        
+        R1 = mvar;
+        R2 = val;
        jump stg_block_putmvar;
     }
   
@@ -1739,17 +1773,14 @@ putMVarzh_fast
 
        /* actually perform the takeMVar */
        tso = StgMVar_head(mvar);
-       PerformTake(tso, R2);
-        dirtyTSO(tso);
+       PerformTake(tso, val);
+        if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+            foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
+        }
       
-#if defined(GRAN) || defined(PAR)
-       /* ToDo: check 2nd arg (mvar) is right */
-       ("ptr" tso) = foreign "C" unblockOne(MyCapability() "ptr", StgMVar_head(mvar) "ptr",mvar "ptr") [];
+        ("ptr" tso) = foreign "C" unblockOne_(MyCapability() "ptr", 
+                                              StgMVar_head(mvar) "ptr", 1) [];
        StgMVar_head(mvar) = tso;
-#else
-       ("ptr" tso) = foreign "C" unblockOne(MyCapability() "ptr", StgMVar_head(mvar) "ptr") [];
-       StgMVar_head(mvar) = tso;
-#endif
 
        if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
            StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
@@ -1765,7 +1796,7 @@ putMVarzh_fast
     else
     {
        /* No further takes, the MVar is now full. */
-       StgMVar_value(mvar) = R2;
+       StgMVar_value(mvar) = val;
 
 #if defined(THREADED_RTS)
        unlockClosure(mvar, stg_MVAR_DIRTY_info);
@@ -1812,16 +1843,13 @@ tryPutMVarzh_fast
        /* actually perform the takeMVar */
        tso = StgMVar_head(mvar);
        PerformTake(tso, R2);
-        dirtyTSO(tso);
+        if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+            foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
+        }
       
-#if defined(GRAN) || defined(PAR)
-       /* ToDo: check 2nd arg (mvar) is right */
-       ("ptr" tso) = foreign "C" unblockOne(MyCapability() "ptr", StgMVar_head(mvar) "ptr",mvar "ptr") [];
+        ("ptr" tso) = foreign "C" unblockOne_(MyCapability() "ptr", 
+                                              StgMVar_head(mvar) "ptr", 1) [];
        StgMVar_head(mvar) = tso;
-#else
-       ("ptr" tso) = foreign "C" unblockOne(MyCapability() "ptr", StgMVar_head(mvar) "ptr") [];
-       StgMVar_head(mvar) = tso;
-#endif
 
        if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
            StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
@@ -2037,11 +2065,11 @@ for2:
  * macro in Schedule.h).
  */
 #define APPEND_TO_BLOCKED_QUEUE(tso)                   \
-    ASSERT(StgTSO_link(tso) == END_TSO_QUEUE);         \
+    ASSERT(StgTSO__link(tso) == END_TSO_QUEUE);                \
     if (W_[blocked_queue_hd] == END_TSO_QUEUE) {       \
       W_[blocked_queue_hd] = tso;                      \
     } else {                                           \
-      StgTSO_link(W_[blocked_queue_tl]) = tso;         \
+      foreign "C" setTSOLink(MyCapability() "ptr", W_[blocked_queue_tl] "ptr", tso) []; \
     }                                                  \
     W_[blocked_queue_tl] = tso;
 
@@ -2137,15 +2165,15 @@ delayzh_fast
 while:
     if (t != END_TSO_QUEUE && StgTSO_block_info(t) < target) {
        prev = t;
-       t = StgTSO_link(t);
+       t = StgTSO__link(t);
        goto while;
     }
 
-    StgTSO_link(CurrentTSO) = t;
+    StgTSO__link(CurrentTSO) = t;
     if (prev == NULL) {
        W_[sleeping_queue] = CurrentTSO;
     } else {
-       StgTSO_link(prev) = CurrentTSO;
+        foreign "C" setTSOLink(MyCapability() "ptr", prev "ptr", CurrentTSO) [];
     }
     jump stg_block_noregs;
 #endif