X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FHeapStackCheck.cmm;h=4e5dd2459636f177961d4f9934e87206b20a9236;hb=86f2671b37507012692a53c2fe45357b0988cb40;hp=ea2d64fa97beec374378c417d5e865ff66c98b21;hpb=9e10d632f946bae5dd9a9ccd199c8345ca696d15;p=ghc-hetmet.git

diff --git a/ghc/rts/HeapStackCheck.cmm b/ghc/rts/HeapStackCheck.cmm
index ea2d64f..4e5dd24 100644
--- a/ghc/rts/HeapStackCheck.cmm
+++ b/ghc/rts/HeapStackCheck.cmm
@@ -42,6 +42,11 @@
  * at all, it won't yield.  Hopefully this won't be a problem in practice.
  */
  
+#define PRE_RETURN(why,what_next)			\
+  StgTSO_what_next(CurrentTSO) = what_next::I16;	\
+  StgRegTable_rRet(BaseReg) = why;           	        \
+  R1 = BaseReg;
+
 /* Remember that the return address is *removed* when returning to a
  * ThreadRunGHC thread.
  */
@@ -69,13 +74,9 @@
         R1 = StackOverflow;					\
     }								\
   sched:							\
-    StgTSO_what_next(CurrentTSO) = ThreadRunGHC::I16;		\
+    PRE_RETURN(R1,ThreadRunGHC);				\
     jump stg_returnToSched;
 
-#define PRE_RETURN(why,what_next)			\
-  StgTSO_what_next(CurrentTSO) = what_next::I16;	\
-  R1 = why;
-
 #define HP_GENERIC				\
    PRE_RETURN(HeapOverflow, ThreadRunGHC)	\
   jump stg_returnToSched;
@@ -839,7 +840,7 @@ INFO_TABLE_RET( stg_block_takemvar, 1/*framesize*/, 0/*bitmap*/, RET_SMALL )
 // code fragment executed just before we return to the scheduler
 stg_block_takemvar_finally
 {
-#ifdef SMP
+#ifdef THREADED_RTS
     foreign "C" unlockClosure(R3 "ptr", stg_EMPTY_MVAR_info);
 #endif
     jump StgReturn;
@@ -865,7 +866,7 @@ INFO_TABLE_RET( stg_block_putmvar, 2/*framesize*/, 0/*bitmap*/, RET_SMALL )
 // code fragment executed just before we return to the scheduler
 stg_block_putmvar_finally
 {
-#ifdef SMP
+#ifdef THREADED_RTS
     foreign "C" unlockClosure(R3 "ptr", stg_FULL_MVAR_info);
 #endif
     jump StgReturn;
@@ -884,7 +885,7 @@ stg_block_putmvar
 // code fragment executed just before we return to the scheduler
 stg_block_blackhole_finally
 {
-#if defined(SMP)
+#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.
@@ -946,3 +947,18 @@ stg_block_async_void
 }
 
 #endif
+
+/* -----------------------------------------------------------------------------
+   STM-specific waiting
+   -------------------------------------------------------------------------- */
+
+stg_block_stmwait_finally
+{
+    foreign "C" stmWaitUnlock(MyCapability() "ptr", R3 "ptr");
+    jump StgReturn;
+}
+
+stg_block_stmwait
+{
+    BLOCK_BUT_FIRST(stg_block_stmwait_finally);
+}