X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSchedule.c;h=e9d4327724e9db9c33dfdc0998132935d95d4991;hb=72547264724117d689a7fa400104185557fb2a0c;hp=51a8d2a842466069fbed9adbb82bd426cb71198a;hpb=dd56e9ab4544e83d27532a8d9058140bfe81825c;p=ghc-hetmet.git

diff --git a/rts/Schedule.c b/rts/Schedule.c
index 51a8d2a..e9d4327 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -9,34 +9,25 @@
 #include "PosixSource.h"
 #define KEEP_LOCKCLOSURE
 #include "Rts.h"
-#include "SchedAPI.h"
+
+#include "sm/Storage.h"
 #include "RtsUtils.h"
-#include "RtsFlags.h"
-#include "OSThreads.h"
-#include "Storage.h"
 #include "StgRun.h"
-#include "Hooks.h"
 #include "Schedule.h"
-#include "StgMiscClosures.h"
 #include "Interpreter.h"
 #include "Printer.h"
 #include "RtsSignals.h"
 #include "Sanity.h"
 #include "Stats.h"
 #include "STM.h"
-#include "Timer.h"
 #include "Prelude.h"
 #include "ThreadLabels.h"
-#include "LdvProfile.h"
 #include "Updates.h"
 #include "Proftimer.h"
 #include "ProfHeap.h"
-#include "GC.h"
 #include "Weak.h"
-#include "EventLog.h"
-
-/* PARALLEL_HASKELL includes go here */
-
+#include "eventlog/EventLog.h"
+#include "sm/GC.h" // waitForGcThreads, releaseGCThreads, N
 #include "Sparks.h"
 #include "Capability.h"
 #include "Task.h"
@@ -47,7 +38,8 @@
 #include "Trace.h"
 #include "RaiseAsync.h"
 #include "Threads.h"
-#include "ThrIOManager.h"
+#include "Timer.h"
+#include "ThreadPaused.h"
 
 #ifdef HAVE_SYS_TYPES_H
 #include <sys/types.h>
@@ -64,12 +56,6 @@
 #include <errno.h>
 #endif
 
-// Turn off inlining when debugging - it obfuscates things
-#ifdef DEBUG
-# undef  STATIC_INLINE
-# define STATIC_INLINE static
-#endif
-
 /* -----------------------------------------------------------------------------
  * Global variables
  * -------------------------------------------------------------------------- */
@@ -150,7 +136,7 @@ static Capability *schedule (Capability *initialCapability, Task *task);
 static void schedulePreLoop (void);
 static void scheduleFindWork (Capability *cap);
 #if defined(THREADED_RTS)
-static void scheduleYield (Capability **pcap, Task *task);
+static void scheduleYield (Capability **pcap, Task *task, rtsBool);
 #endif
 static void scheduleStartSignalHandlers (Capability *cap);
 static void scheduleCheckBlockedThreads (Capability *cap);
@@ -188,12 +174,12 @@ static void deleteThread_(Capability *cap, StgTSO *tso);
 
 #ifdef DEBUG
 static char *whatNext_strs[] = {
-  "(unknown)",
-  "ThreadRunGHC",
-  "ThreadInterpret",
-  "ThreadKilled",
-  "ThreadRelocated",
-  "ThreadComplete"
+  [0]               = "(unknown)",
+  [ThreadRunGHC]    = "ThreadRunGHC",
+  [ThreadInterpret] = "ThreadInterpret",
+  [ThreadKilled]    = "ThreadKilled",
+  [ThreadRelocated] = "ThreadRelocated",
+  [ThreadComplete]  = "ThreadComplete"
 };
 #endif
 
@@ -254,6 +240,7 @@ schedule (Capability *initialCapability, Task *task)
   rtsBool ready_to_gc;
 #if defined(THREADED_RTS)
   rtsBool first = rtsTrue;
+  rtsBool force_yield = rtsFalse;
 #endif
   
   cap = initialCapability;
@@ -266,14 +253,6 @@ schedule (Capability *initialCapability, Task *task)
 	      "### NEW SCHEDULER LOOP (task: %p, cap: %p)",
 	      task, initialCapability);
 
-  if (running_finalizers) {
-      errorBelch("error: a C finalizer called back into Haskell.\n"
-                 "   This was previously allowed, but is disallowed in GHC 6.10.2 and later.\n"
-                 "   To create finalizers that may call back into Haskll, use\n"
-                 "   Foreign.Concurrent.newForeignPtr instead of Foreign.newForeignPtr.");
-      stg_exit(EXIT_FAILURE);
-  }
-
   schedulePreLoop();
 
   // -----------------------------------------------------------
@@ -388,7 +367,9 @@ schedule (Capability *initialCapability, Task *task)
     }
 
   yield:
-    scheduleYield(&cap,task);
+    scheduleYield(&cap,task,force_yield);
+    force_yield = rtsFalse;
+
     if (emptyRunQueue(cap)) continue; // look for work again
 #endif
 
@@ -567,6 +548,7 @@ run_thread:
 	debugTrace(DEBUG_sched,
 		   "--<< thread %lu (%s) stopped: blocked",
 		   (unsigned long)t->id, whatNext_strs[t->what_next]);
+        force_yield = rtsTrue;
         goto yield;
     }
 #endif
@@ -584,7 +566,9 @@ run_thread:
     
     schedulePostRunThread(cap,t);
 
-    t = threadStackUnderflow(task,t);
+    if (ret != StackOverflow) {
+        t = threadStackUnderflow(task,t);
+    }
 
     ready_to_gc = rtsFalse;
 
@@ -687,12 +671,23 @@ shouldYieldCapability (Capability *cap, Task *task)
 // and also check the benchmarks in nofib/parallel for regressions.
 
 static void
-scheduleYield (Capability **pcap, Task *task)
+scheduleYield (Capability **pcap, Task *task, rtsBool force_yield)
 {
     Capability *cap = *pcap;
 
     // if we have work, and we don't need to give up the Capability, continue.
-    if (!shouldYieldCapability(cap,task) && 
+    //
+    // The force_yield flag is used when a bound thread blocks.  This
+    // is a particularly tricky situation: the current Task does not
+    // own the TSO any more, since it is on some queue somewhere, and
+    // might be woken up or manipulated by another thread at any time.
+    // The TSO and Task might be migrated to another Capability.
+    // Certain invariants might be in doubt, such as task->bound->cap
+    // == cap.  We have to yield the current Capability immediately,
+    // no messing around.
+    //
+    if (!force_yield &&
+        !shouldYieldCapability(cap,task) && 
         (!emptyRunQueue(cap) ||
          !emptyWakeupQueue(cap) ||
          blackholes_need_checking ||
@@ -1129,10 +1124,6 @@ scheduleHandleHeapOverflow( Capability *cap, StgTSO *t )
 	    if (cap->r.rCurrentNursery->u.back != NULL) {
 		cap->r.rCurrentNursery->u.back->link = bd;
 	    } else {
-#if !defined(THREADED_RTS)
-		ASSERT(g0s0->blocks == cap->r.rCurrentNursery &&
-		       g0s0 == cap->r.rNursery);
-#endif
 		cap->r.rNursery->blocks = bd;
 	    }		  
 	    cap->r.rCurrentNursery->u.back = bd;
@@ -1729,7 +1720,6 @@ forkProcess(HsStablePtr *entry
     }
 #else /* !FORKPROCESS_PRIMOP_SUPPORTED */
     barf("forkProcess#: primop not supported on this platform, sorry!\n");
-    return -1;
 #endif
 }
 
@@ -2381,7 +2371,9 @@ interruptStgRts(void)
 {
     sched_state = SCHED_INTERRUPTING;
     setContextSwitches();
+#if defined(THREADED_RTS)
     wakeUpRts();
+#endif
 }
 
 /* -----------------------------------------------------------------------------
@@ -2397,16 +2389,15 @@ interruptStgRts(void)
    will have interrupted any blocking system call in progress anyway.
    -------------------------------------------------------------------------- */
 
-void
-wakeUpRts(void)
-{
 #if defined(THREADED_RTS)
+void wakeUpRts(void)
+{
     // This forces the IO Manager thread to wakeup, which will
     // in turn ensure that some OS thread wakes up and runs the
     // scheduler loop, which will cause a GC and deadlock check.
     ioManagerWakeup();
-#endif
 }
+#endif
 
 /* -----------------------------------------------------------------------------
  * checkBlackHoles()