merge upstream HEAD

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

diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm
index 5bdf600..d179611 100644 (file)
--- a/rts/HeapStackCheck.cmm
+++ b/rts/HeapStackCheck.cmm
@@ -159,6 +159,24 @@ __stg_gc_enter_1
 }
 
 /* -----------------------------------------------------------------------------
+   stg_enter_checkbh is just like stg_enter, except that we also call
+   checkBlockingQueues().  The point of this is that the GC can
+   replace an stg_marked_upd_frame with an stg_enter_checkbh if it
+   finds that the BLACKHOLE has already been updated by another
+   thread.  It would be unsafe to use stg_enter, because there might
+   be an orphaned BLOCKING_QUEUE now.
+   -------------------------------------------------------------------------- */
+
+INFO_TABLE_RET( stg_enter_checkbh, RET_SMALL, P_ unused)
+{
+    R1 = Sp(1);
+    Sp_adj(2);
+    foreign "C" checkBlockingQueues(MyCapability() "ptr",
+                                    CurrentTSO) [R1];
+    ENTER();
+}
+
+/* -----------------------------------------------------------------------------
    Heap checks in Primitive case alternatives
 
    A primitive case alternative is entered with a value either in 
@@ -463,9 +481,13 @@ INFO_TABLE_RET( stg_gc_gen, RET_DYN )
 
 stg_gc_gen
 {
+    // Hack; see Note [mvar-heap-check] in PrimOps.cmm
+    if (R10 == stg_putMVarzh || R10 == stg_takeMVarzh) {
+       unlockClosure(R1, stg_MVAR_DIRTY_info)
+    }
     SAVE_EVERYTHING;
     GC_GENERIC
-}        
+}
 
 // A heap check at an unboxed tuple return point.  The return address
 // is on the stack, and we can find it by using the offsets given
@@ -565,11 +587,7 @@ INFO_TABLE_RET( stg_block_takemvar, RET_SMALL, P_ unused )
 // code fragment executed just before we return to the scheduler
 stg_block_takemvar_finally
 {
-#ifdef THREADED_RTS
     unlockClosure(R3, stg_MVAR_DIRTY_info);
-#else
-    SET_INFO(R3, stg_MVAR_DIRTY_info);
-#endif
     jump StgReturn;
 }
 
@@ -593,11 +611,7 @@ INFO_TABLE_RET( stg_block_putmvar, RET_SMALL, P_ unused1, P_ unused2 )
 // code fragment executed just before we return to the scheduler
 stg_block_putmvar_finally
 {
-#ifdef THREADED_RTS
     unlockClosure(R3, stg_MVAR_DIRTY_info);
-#else
-    SET_INFO(R3, stg_MVAR_DIRTY_info);
-#endif
     jump StgReturn;
 }
 
@@ -611,24 +625,12 @@ stg_block_putmvar
     BLOCK_BUT_FIRST(stg_block_putmvar_finally);
 }
 
-// code fragment executed just before we return to the scheduler
-stg_block_blackhole_finally
-{
-#if defined(THREADED_RTS)
-    // The last thing we do is release sched_lock, which is
-    // preventing other threads from accessing blackhole_queue and
-    // picking up this thread before we are finished with it.
-    RELEASE_LOCK(sched_mutex "ptr");
-#endif
-    jump StgReturn;
-}
-
 stg_block_blackhole
 {
     Sp_adj(-2);
     Sp(1) = R1;
     Sp(0) = stg_enter_info;
-    BLOCK_BUT_FIRST(stg_block_blackhole_finally);
+    BLOCK_GENERIC;
 }
 
 INFO_TABLE_RET( stg_block_throwto, RET_SMALL, P_ unused, P_ unused )
@@ -660,24 +662,24 @@ stg_block_throwto
 }
 
 #ifdef mingw32_HOST_OS
-INFO_TABLE_RET( stg_block_async, RET_SMALL )
+INFO_TABLE_RET( stg_block_async, RET_SMALL, W_ unused )
 {
     W_ ares;
     W_ len, errC;
 
-    ares = StgTSO_block_info(CurrentTSO);
+    ares = Sp(1);
     len = StgAsyncIOResult_len(ares);
     errC = StgAsyncIOResult_errCode(ares);
-    StgTSO_block_info(CurrentTSO) = NULL;
     foreign "C" free(ares "ptr");
     R1 = len;
+    Sp_adj(1);
     Sp(0) = errC;
     jump %ENTRY_CODE(Sp(1));
 }
 
 stg_block_async
 {
-    Sp_adj(-1);
+    Sp_adj(-2);
     Sp(0) = stg_block_async_info;
     BLOCK_GENERIC;
 }
@@ -685,20 +687,19 @@ stg_block_async
 /* Used by threadDelay implementation; it would be desirable to get rid of
  * this free()'ing void return continuation.
  */
-INFO_TABLE_RET( stg_block_async_void, RET_SMALL )
+INFO_TABLE_RET( stg_block_async_void, RET_SMALL, W_ ares )
 {
     W_ ares;
 
-    ares = StgTSO_block_info(CurrentTSO);
-    StgTSO_block_info(CurrentTSO) = NULL;
+    ares = Sp(1);
     foreign "C" free(ares "ptr");
-    Sp_adj(1);
+    Sp_adj(2);
     jump %ENTRY_CODE(Sp(0));
 }
 
 stg_block_async_void
 {
-    Sp_adj(-1);
+    Sp_adj(-2);
     Sp(0) = stg_block_async_void_info;
     BLOCK_GENERIC;
 }