tracing wibble (make -ls work with a -debug RTS)

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

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index bc2d07a..d5b6c46 100644 (file)
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1173,7 +1173,7 @@ stg_takeMVarzh
       tso = StgMVar_head(mvar);
       PerformPut(tso,StgMVar_value(mvar));
 
-      if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+      if (TO_W_(StgTSO_dirty(tso)) == 0) {
           foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
       }
 
@@ -1249,7 +1249,7 @@ stg_tryTakeMVarzh
        /* 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_flags(tso)) & TSO_DIRTY == 0) {
+        if (TO_W_(StgTSO_dirty(tso)) == 0) {
             foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
         }
 
@@ -1329,7 +1329,7 @@ stg_putMVarzh
        /* actually perform the takeMVar */
        tso = StgMVar_head(mvar);
        PerformTake(tso, val);
-        if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+        if (TO_W_(StgTSO_dirty(tso)) == 0) {
             foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
         }
       
@@ -1398,7 +1398,7 @@ stg_tryPutMVarzh
        /* actually perform the takeMVar */
        tso = StgMVar_head(mvar);
        PerformTake(tso, R2);
-        if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+        if (TO_W_(StgTSO_dirty(tso)) == 0) {
             foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
         }
       
@@ -1894,3 +1894,13 @@ stg_getSparkzh
    }
 #endif
 }
+
+stg_traceEventzh
+{
+   W_ msg;
+   msg = R1;
+#if defined(TRACING) || defined(DEBUG)
+   foreign "C" traceUserMsg(MyCapability() "ptr", msg "ptr") [];
+#endif
+   jump %ENTRY_CODE(Sp(0));
+}