X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FSchedule.c;h=3d87003756ff7f72fbb9f0ba696e627f2ab9bbd7;hb=85174045bbcc05adb28447d423794d1f087da59e;hp=a11a15e94d9733a9a84c79adddaa61e60597dc66;hpb=ed12b7043fa98928f75c289a756fbcef546315f8;p=ghc-hetmet.git

diff --git a/rts/Schedule.c b/rts/Schedule.c
index a11a15e..3d87003 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -588,6 +588,10 @@ run_thread:
     prev_what_next = t->what_next;
 
     errno = t->saved_errno;
+#if mingw32_HOST_OS
+    SetLastError(t->saved_winerror);
+#endif
+
     cap->in_haskell = rtsTrue;
 
     dirtyTSO(t);
@@ -637,6 +641,10 @@ run_thread:
     // XXX: possibly bogus for SMP because this thread might already
     // be running again, see code below.
     t->saved_errno = errno;
+#if mingw32_HOST_OS
+    // Similarly for Windows error code
+    t->saved_winerror = GetLastError();
+#endif
 
 #if defined(THREADED_RTS)
     // If ret is ThreadBlocked, and this Task is bound to the TSO that
@@ -854,7 +862,8 @@ schedulePushWork(Capability *cap USED_IF_THREADS,
 static void
 scheduleStartSignalHandlers(Capability *cap)
 {
-    if (signals_pending()) { // safe outside the lock
+    if (RtsFlags.MiscFlags.install_signal_handlers && signals_pending()) {
+        // safe outside the lock
 	startSignalHandlers(cap);
     }
 }
@@ -977,7 +986,7 @@ scheduleDetectDeadlock (Capability *cap, Task *task)
 	 * for signals to arrive rather then bombing out with a
 	 * deadlock.
 	 */
-	if ( anyUserHandlers() ) {
+	if ( RtsFlags.MiscFlags.install_signal_handlers && anyUserHandlers() ) {
 	    debugTrace(DEBUG_sched,
 		       "still deadlocked, waiting for signals...");
 
@@ -1768,13 +1777,14 @@ scheduleHandleThreadBlocked( StgTSO *t
       // has tidied up its stack and placed itself on whatever queue
       // it needs to be on.
 
-#if !defined(THREADED_RTS)
-    ASSERT(t->why_blocked != NotBlocked);
-	     // This might not be true under THREADED_RTS: we don't have
-	     // exclusive access to this TSO, so someone might have
-	     // woken it up by now.  This actually happens: try
-	     // conc023 +RTS -N2.
-#endif
+    // ASSERT(t->why_blocked != NotBlocked);
+    // Not true: for example,
+    //    - in THREADED_RTS, the thread may already have been woken
+    //      up by another Capability.  This actually happens: try
+    //      conc023 +RTS -N2.
+    //    - the thread may have woken itself up already, because
+    //      threadPaused() might have raised a blocked throwTo
+    //      exception, see maybePerformBlockedException().
 
 #ifdef DEBUG
     if (traceClass(DEBUG_sched)) {
@@ -1809,7 +1819,7 @@ scheduleHandleThreadFinished (Capability *cap STG_UNUSED, Task *task, StgTSO *t)
 	       (unsigned long)t->id, whatNext_strs[t->what_next]);
 
     /* Inform the Hpc that a thread has finished */
-    hs_hpc_event("Thread Finished",t);
+    hs_hpc_thread_finished_event(t);
 
 #if defined(GRAN)
       endThread(t, CurrentProc); // clean-up the thread
@@ -2101,7 +2111,7 @@ scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major)
  * Singleton fork(). Do not copy any running threads.
  * ------------------------------------------------------------------------- */
 
-StgInt
+pid_t
 forkProcess(HsStablePtr *entry
 #ifndef FORKPROCESS_PRIMOP_SUPPORTED
 	    STG_UNUSED
@@ -2186,6 +2196,10 @@ forkProcess(HsStablePtr *entry
 	cap->returning_tasks_tl = NULL;
 #endif
 
+        // On Unix, all timers are reset in the child, so we need to start
+        // the timer again.
+        startTimer();
+
 	cap = rts_evalStableIO(cap, entry, NULL);  // run the action
 	rts_checkSchedStatus("forkProcess",cap);
 	
@@ -2282,9 +2296,17 @@ void *
 suspendThread (StgRegTable *reg)
 {
   Capability *cap;
-  int saved_errno = errno;
+  int saved_errno;
   StgTSO *tso;
   Task *task;
+#if mingw32_HOST_OS
+  StgWord32 saved_winerror;
+#endif
+
+  saved_errno = errno;
+#if mingw32_HOST_OS
+  saved_winerror = GetLastError();
+#endif
 
   /* assume that *reg is a pointer to the StgRegTable part of a Capability.
    */
@@ -2329,6 +2351,9 @@ suspendThread (StgRegTable *reg)
 #endif
 
   errno = saved_errno;
+#if mingw32_HOST_OS
+  SetLastError(saved_winerror);
+#endif
   return task;
 }
 
@@ -2337,8 +2362,16 @@ resumeThread (void *task_)
 {
     StgTSO *tso;
     Capability *cap;
-    int saved_errno = errno;
     Task *task = task_;
+    int saved_errno;
+#if mingw32_HOST_OS
+    StgWord32 saved_winerror;
+#endif
+
+    saved_errno = errno;
+#if mingw32_HOST_OS
+    saved_winerror = GetLastError();
+#endif
 
     cap = task->cap;
     // Wait for permission to re-enter the RTS with the result.
@@ -2366,6 +2399,9 @@ resumeThread (void *task_)
     cap->r.rCurrentTSO = tso;
     cap->in_haskell = rtsTrue;
     errno = saved_errno;
+#if mingw32_HOST_OS
+    SetLastError(saved_winerror);
+#endif
 
     /* We might have GC'd, mark the TSO dirty again */
     dirtyTSO(tso);
@@ -2673,7 +2709,9 @@ GetRoots( evac_fn evac )
     
 #if defined(RTS_USER_SIGNALS)
     // mark the signal handlers (signals should be already blocked)
-    markSignalHandlers(evac);
+    if (RtsFlags.MiscFlags.install_signal_handlers) {
+        markSignalHandlers(evac);
+    }
 #endif
 }