[project @ 2005-03-10 14:03:28 by simonmar]

[ghc-hetmet.git] / ghc / rts / Schedule.c

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 8c0e44e..e2e1db2 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -222,10 +222,6 @@ void            addToBlockedQueue ( StgTSO *tso );
 static void     schedule          ( StgMainThread *mainThread, Capability *initialCapability );
        void     interruptStgRts   ( void );
 
-#if !defined(PAR) && !defined(RTS_SUPPORTS_THREADS)
-static void     detectBlackHoles  ( void );
-#endif
-
 static void     raiseAsync_(StgTSO *tso, StgClosure *exception, rtsBool stop_at_atomically);
 
 #if defined(RTS_SUPPORTS_THREADS)
@@ -358,15 +354,6 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS,
   // We might have a capability, passed in as initialCapability.
   cap = initialCapability;
 
-  // Check whether we have re-entered the RTS from Haskell without
-  // going via suspendThread()/resumeThread (i.e. a 'safe' foreign
-  // call).
-  if (in_haskell) {
-      errorBelch("schedule: re-entered unsafely.\n"
-                "   Perhaps a 'foreign import unsafe' should be 'safe'?");
-      stg_exit(1);
-  }
-
 #if defined(RTS_SUPPORTS_THREADS)
   //
   // in the threaded case, the capability is either passed in via the
@@ -435,6 +422,15 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS,
       // We now have a capability...
 #endif
 
+    // Check whether we have re-entered the RTS from Haskell without
+    // going via suspendThread()/resumeThread (i.e. a 'safe' foreign
+    // call).
+    if (in_haskell) {
+         errorBelch("schedule: re-entered unsafely.\n"
+                    "   Perhaps a 'foreign import unsafe' should be 'safe'?");
+         stg_exit(1);
+    }
+
     //
     // If we're interrupted (the user pressed ^C, or some other
     // termination condition occurred), kill all the currently running
@@ -1064,7 +1060,6 @@ run_thread:
 #endif
       
       ready_to_gc = rtsTrue;
-      context_switch = 1;              /* stop other threads ASAP */
       PUSH_ON_RUN_QUEUE(t);
       /* actual GC is done at the end of the while loop */
       break;
@@ -1601,10 +1596,10 @@ suspendThread( StgRegTable *reg )
   IF_DEBUG(scheduler, sched_belch("worker (token %d): leaving RTS", tok));
 #endif
 
+  in_haskell = rtsFalse;
   RELEASE_LOCK(&sched_mutex);
   
   errno = saved_errno;
-  in_haskell = rtsFalse;
   return tok; 
 }
 
@@ -1649,9 +1644,9 @@ resumeThread( StgInt tok )
   tso->why_blocked  = NotBlocked;
 
   cap->r.rCurrentTSO = tso;
+  in_haskell = rtsTrue;
   RELEASE_LOCK(&sched_mutex);
   errno = saved_errno;
-  in_haskell = rtsTrue;
   return &cap->r;
 }
 
@@ -2350,7 +2345,6 @@ threadStackOverflow(StgTSO *tso)
   tso->link = dest;
   tso->sp = (P_)&(tso->stack[tso->stack_size]);
   tso->why_blocked = NotBlocked;
-  dest->mut_link = NULL;
 
   IF_PAR_DEBUG(verbose,
               debugBelch("@@ threadStackOverflow of TSO %d (now at %p): stack size increased to %ld\n",