X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FHeapStackCheck.cmm;h=ea2d64fa97beec374378c417d5e865ff66c98b21;hb=a3a331064b5020f77bf676a3d4eb74650ae7b8c3;hp=2a264b2aa02d8e38fbaad03fe045ccb67f6def8e;hpb=b4d045ae655e5eae25b88917cfe75d7dc7689c21;p=ghc-hetmet.git

diff --git a/ghc/rts/HeapStackCheck.cmm b/ghc/rts/HeapStackCheck.cmm
index 2a264b2..ea2d64f 100644
--- a/ghc/rts/HeapStackCheck.cmm
+++ b/ghc/rts/HeapStackCheck.cmm
@@ -55,7 +55,7 @@
             CLOSE_NURSERY();					\
             CurrentNursery = bdescr_link(CurrentNursery);	\
             OPEN_NURSERY();					\
-            if (CInt[context_switch] != 0) {			\
+            if (CInt[context_switch] != 0 :: CInt) {		\
                 R1 = ThreadYielding;				\
                 goto sched;					\
             } else {						\
@@ -69,20 +69,33 @@
         R1 = StackOverflow;					\
     }								\
   sched:							\
-    SAVE_THREAD_STATE();					\
     StgTSO_what_next(CurrentTSO) = ThreadRunGHC::I16;		\
-    jump StgReturn;
+    jump stg_returnToSched;
 
-#define RETURN_TO_SCHED(why,what_next)			\
-  SAVE_THREAD_STATE();					\
+#define PRE_RETURN(why,what_next)			\
   StgTSO_what_next(CurrentTSO) = what_next::I16;	\
-  R1 = why;						\
-  jump StgReturn;
+  R1 = why;
+
+#define HP_GENERIC				\
+   PRE_RETURN(HeapOverflow, ThreadRunGHC)	\
+  jump stg_returnToSched;
+
+#define BLOCK_GENERIC				\
+   PRE_RETURN(ThreadBlocked,  ThreadRunGHC)	\
+  jump stg_returnToSched;
+
+#define YIELD_GENERIC				\
+  PRE_RETURN(ThreadYielding, ThreadRunGHC)	\
+  jump stg_returnToSched;
 
-#define HP_GENERIC           RETURN_TO_SCHED(HeapOverflow,   ThreadRunGHC)
-#define YIELD_GENERIC        RETURN_TO_SCHED(ThreadYielding, ThreadRunGHC)
-#define YIELD_TO_INTERPRETER RETURN_TO_SCHED(ThreadYielding, ThreadInterpret)
-#define BLOCK_GENERIC        RETURN_TO_SCHED(ThreadBlocked,  ThreadRunGHC)
+#define BLOCK_BUT_FIRST(c)			\
+  PRE_RETURN(ThreadBlocked, ThreadRunGHC)	\
+  R2 = c;					\
+  jump stg_returnToSchedButFirst;
+
+#define YIELD_TO_INTERPRETER			\
+  PRE_RETURN(ThreadYielding, ThreadInterpret)	\
+  jump stg_returnToSchedNotPaused;
 
 /* -----------------------------------------------------------------------------
    Heap checks in thunks/functions.
@@ -109,18 +122,6 @@ __stg_gc_enter_1
     GC_GENERIC
 }
 
-#ifdef SMP
-stg_gc_enter_1_hponly
-{
-    Sp_adj(-1);
-    Sp(0) = R1;
-    R1 = HeapOverflow;
-    SAVE_THREAD_STATE();
-    TSO_what_next(CurrentTSO) = ThreadRunGHC::I16;
-    jump StgReturn;
-}
-#endif
-
 #if defined(GRAN)
 /*
   ToDo: merge the block and yield macros, calling something like BLOCK(N)
@@ -623,13 +624,13 @@ __stg_gc_fun
         Sp(2) = R1;
         Sp(1) = size;
         Sp(0) = stg_gc_fun_info;
-        // DEBUG_ONLY(foreign "C" fprintf(stderr, "stg_fun_gc_gen(ARG_GEN)"););
+        // DEBUG_ONLY(foreign "C" debugBelch("stg_fun_gc_gen(ARG_GEN)"););
         GC_GENERIC
     } else { 
 	jump W_[stg_stack_save_entries + WDS(type)];
 	    // jumps to stg_gc_noregs after saving stuff
     }
-#endif // !NO_ARG_REGS
+#endif /* !NO_ARG_REGS */
 }
 
 /* -----------------------------------------------------------------------------
@@ -723,7 +724,7 @@ INFO_TABLE_RET( stg_gc_fun, 0/*framesize*/, 0/*bitmap*/, RET_FUN )
     Sp(5) = R3;					\
     Sp(4) = R2;					\
     Sp(3) = R1;					\
-    Sp(2) = R10.w;    /* return address */	\
+    Sp(2) = R10;    /* return address */	\
     Sp(1) = R9;     /* liveness mask  */	\
     Sp(0) = stg_gc_gen_info;
 
@@ -835,12 +836,22 @@ INFO_TABLE_RET( stg_block_takemvar, 1/*framesize*/, 0/*bitmap*/, RET_SMALL )
     jump takeMVarzh_fast;
 }
 
+// code fragment executed just before we return to the scheduler
+stg_block_takemvar_finally
+{
+#ifdef SMP
+    foreign "C" unlockClosure(R3 "ptr", stg_EMPTY_MVAR_info);
+#endif
+    jump StgReturn;
+}
+
 stg_block_takemvar
 {
     Sp_adj(-2);
     Sp(1) = R1;
     Sp(0) = stg_block_takemvar_info;
-    BLOCK_GENERIC;
+    R3 = R1;
+    BLOCK_BUT_FIRST(stg_block_takemvar_finally);
 }
 
 INFO_TABLE_RET( stg_block_putmvar, 2/*framesize*/, 0/*bitmap*/, RET_SMALL )
@@ -851,16 +862,46 @@ INFO_TABLE_RET( stg_block_putmvar, 2/*framesize*/, 0/*bitmap*/, RET_SMALL )
     jump putMVarzh_fast;
 }
 
+// code fragment executed just before we return to the scheduler
+stg_block_putmvar_finally
+{
+#ifdef SMP
+    foreign "C" unlockClosure(R3 "ptr", stg_FULL_MVAR_info);
+#endif
+    jump StgReturn;
+}
+
 stg_block_putmvar
 {
     Sp_adj(-3);
     Sp(2) = R2;
     Sp(1) = R1;
     Sp(0) = stg_block_putmvar_info;
-    BLOCK_GENERIC;
+    R3 = R1;
+    BLOCK_BUT_FIRST(stg_block_putmvar_finally);
 }
 
-#ifdef mingw32_TARGET_OS
+// code fragment executed just before we return to the scheduler
+stg_block_blackhole_finally
+{
+#if defined(SMP)
+    // 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.
+    foreign "C" 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);
+}
+
+#ifdef mingw32_HOST_OS
 INFO_TABLE_RET( stg_block_async, 0/*framesize*/, 0/*bitmap*/, RET_SMALL )
 {
     W_ ares;
@@ -883,4 +924,25 @@ stg_block_async
     BLOCK_GENERIC;
 }
 
+/* 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, 0/*framesize*/, 0/*bitmap*/, RET_SMALL )
+{
+    W_ ares;
+
+    ares = StgTSO_block_info(CurrentTSO);
+    StgTSO_block_info(CurrentTSO) = NULL;
+    foreign "C" free(ares "ptr");
+    Sp_adj(1);
+    jump %ENTRY_CODE(Sp(0));
+}
+
+stg_block_async_void
+{
+    Sp_adj(-1);
+    Sp(0) = stg_block_async_void_info;
+    BLOCK_GENERIC;
+}
+
 #endif