[project @ 2006-01-18 10:31:50 by simonmar]

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

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 4891bbf..21bd59b 100644 (file)
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -72,20 +72,6 @@
 # define STATIC_INLINE static
 #endif
 
-#ifdef THREADED_RTS
-#define USED_WHEN_THREADED_RTS
-#define USED_WHEN_NON_THREADED_RTS STG_UNUSED
-#else
-#define USED_WHEN_THREADED_RTS     STG_UNUSED
-#define USED_WHEN_NON_THREADED_RTS
-#endif
-
-#ifdef SMP
-#define USED_WHEN_SMP
-#else
-#define USED_WHEN_SMP STG_UNUSED
-#endif
-
 /* -----------------------------------------------------------------------------
  * Global variables
  * -------------------------------------------------------------------------- */
@@ -387,7 +373,7 @@ schedule (Capability *initialCapability, Task *task)
          // thread for a bit, even if there are others banging at the
          // door.
          first = rtsFalse;
-         ASSERT_CAPABILITY_INVARIANTS(cap,task);
+         ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
       } else {
          // Yield the capability to higher-priority tasks if necessary.
          yieldCapability(&cap, task);
@@ -633,13 +619,13 @@ run_thread:
     // immediately and return to normaility.
     if (ret == ThreadBlocked) {
        IF_DEBUG(scheduler,
-                debugBelch("--<< thread %d (%s) stopped: blocked\n",
-                           t->id, whatNext_strs[t->what_next]));
+                sched_belch("--<< thread %d (%s) stopped: blocked\n",
+                            t->id, whatNext_strs[t->what_next]));
        continue;
     }
 #endif
 
-    ASSERT_CAPABILITY_INVARIANTS(cap,task);
+    ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
 
     // ----------------------------------------------------------------------
     
@@ -681,7 +667,7 @@ run_thread:
 
     case ThreadFinished:
        if (scheduleHandleThreadFinished(cap, task, t)) return cap;
-       ASSERT_CAPABILITY_INVARIANTS(cap,task);
+       ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
        break;
 
     default:
@@ -730,8 +716,8 @@ schedulePreLoop(void)
 
 #ifdef SMP
 static void
-schedulePushWork(Capability *cap USED_WHEN_SMP, 
-                Task *task      USED_WHEN_SMP)
+schedulePushWork(Capability *cap USED_IF_SMP, 
+                Task *task      USED_IF_SMP)
 {
     Capability *free_caps[n_capabilities], *cap0;
     nat i, n_free_caps;
@@ -795,6 +781,7 @@ schedulePushWork(Capability *cap USED_WHEN_SMP,
                    prev->link = t;
                    prev = t;
                } else {
+                   IF_DEBUG(scheduler, sched_belch("pushing thread %d to capability %d", t->id, free_caps[i]->no));
                    appendToRunQueue(free_caps[i],t);
                    if (t->bound) { t->bound->cap = free_caps[i]; }
                    i++;
@@ -853,7 +840,7 @@ scheduleStartSignalHandlers(Capability *cap STG_UNUSED)
  * ------------------------------------------------------------------------- */
 
 static void
-scheduleCheckBlockedThreads(Capability *cap USED_WHEN_NON_THREADED_RTS)
+scheduleCheckBlockedThreads(Capability *cap USED_IF_NOT_THREADS)
 {
 #if !defined(THREADED_RTS)
     //
@@ -1881,7 +1868,7 @@ scheduleDoHeapProfile( rtsBool ready_to_gc STG_UNUSED )
  * -------------------------------------------------------------------------- */
 
 static void
-scheduleDoGC( Capability *cap, Task *task USED_WHEN_SMP, rtsBool force_major )
+scheduleDoGC( Capability *cap, Task *task USED_IF_SMP, rtsBool force_major )
 {
     StgTSO *t;
 #ifdef SMP
@@ -2021,7 +2008,7 @@ rtsSupportsBoundThreads(void)
  * ------------------------------------------------------------------------- */
  
 StgBool
-isThreadBound(StgTSO* tso USED_WHEN_THREADED_RTS)
+isThreadBound(StgTSO* tso USED_IF_THREADS)
 {
 #if defined(THREADED_RTS)
   return (tso->bound != NULL);
@@ -2087,9 +2074,13 @@ forkProcess(HsStablePtr *entry
        }
        RELEASE_LOCK(&sched_mutex);
 
+       cap->suspended_ccalling_tasks = NULL;
+
 #if defined(THREADED_RTS)
        // wipe our spare workers list.
        cap->spare_workers = NULL;
+       cap->returning_tasks_hd = NULL;
+       cap->returning_tasks_tl = NULL;
 #endif
 
        cap = rts_evalStableIO(cap, entry, NULL);  // run the action
@@ -2599,7 +2590,7 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability *cap)
     cap = schedule(cap,task);
 
     ASSERT(task->stat != NoStatus);
-    ASSERT_CAPABILITY_INVARIANTS(cap,task);
+    ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
 
     IF_DEBUG(scheduler, sched_belch("bound thread (%d) finished", task->tso->id));
     return cap;
@@ -3746,7 +3737,7 @@ raiseAsync_(Capability *cap, StgTSO *tso, StgClosure *exception,
            sp += sizeofW(StgUpdateFrame) - 1;
            sp[0] = (W_)ap; // push onto stack
            frame = sp + 1;
-           break;
+           continue; //no need to bump frame
        }
 
        case STOP_FRAME:
@@ -3802,7 +3793,7 @@ raiseAsync_(Capability *cap, StgTSO *tso, StgClosure *exception,
        case ATOMICALLY_FRAME:
            if (stop_at_atomically) {
                ASSERT(stmGetEnclosingTRec(tso->trec) == NO_TREC);
-               stmCondemnTransaction(tso -> trec);
+               stmCondemnTransaction(cap, tso -> trec);
 #ifdef REG_R1
                tso->sp = frame;
 #else
@@ -3829,8 +3820,10 @@ raiseAsync_(Capability *cap, StgTSO *tso, StgClosure *exception,
            // and will not be visible after the abort.
            IF_DEBUG(stm,
                     debugBelch("Found atomically block delivering async exception\n"));
-           stmAbortTransaction(tso -> trec);
-           tso -> trec = stmGetEnclosingTRec(tso -> trec);
+            StgTRecHeader *trec = tso -> trec;
+            StgTRecHeader *outer = stmGetEnclosingTRec(trec);
+            stmAbortTransaction(cap, trec);
+            tso -> trec = outer;
            break;
            
        default: