+ RELEASE_LOCK(&sched_mutex);
+
+ IF_DEBUG(scheduler, sched_belch("-->> running thread %ld %s ...",
+ (long)t->id, whatNext_strs[t->what_next]));
+
+#if defined(PROFILING)
+ startHeapProfTimer();
+#endif
+
+ // ----------------------------------------------------------------------
+ // Run the current thread
+
+ prev_what_next = t->what_next;
+
+ errno = t->saved_errno;
+ cap->r.rInHaskell = rtsTrue;
+
+ recent_activity = ACTIVITY_YES;
+
+ switch (prev_what_next) {
+
+ case ThreadKilled:
+ case ThreadComplete:
+ /* Thread already finished, return to scheduler. */
+ ret = ThreadFinished;
+ break;
+
+ case ThreadRunGHC:
+ ret = StgRun((StgFunPtr) stg_returnToStackTop, &cap->r);
+ break;
+
+ case ThreadInterpret:
+ ret = interpretBCO(cap);
+ break;
+
+ default:
+ barf("schedule: invalid what_next field");
+ }
+
+#if defined(SMP)
+ // in SMP mode, we might return with a different capability than
+ // we started with, if the Haskell thread made a foreign call. So
+ // let's find out what our current Capability is:
+ cap = myCapability();
+#endif
+
+ cap->r.rInHaskell = rtsFalse;
+
+ // The TSO might have moved, eg. if it re-entered the RTS and a GC
+ // happened. So find the new location:
+ t = cap->r.rCurrentTSO;
+
+ // And save the current errno in this thread.
+ t->saved_errno = errno;
+
+ // ----------------------------------------------------------------------
+
+ /* Costs for the scheduler are assigned to CCS_SYSTEM */
+#if defined(PROFILING)
+ stopHeapProfTimer();
+ CCCS = CCS_SYSTEM;
+#endif
+
+ ACQUIRE_LOCK(&sched_mutex);
+
+ // We have run some Haskell code: there might be blackhole-blocked
+ // threads to wake up now.
+ if ( blackhole_queue != END_TSO_QUEUE ) {
+ blackholes_need_checking = rtsTrue;
+ }
+
+#if defined(RTS_SUPPORTS_THREADS)
+ IF_DEBUG(scheduler,debugBelch("sched (task %p): ", osThreadId()););
+#elif !defined(GRAN) && !defined(PARALLEL_HASKELL)
+ IF_DEBUG(scheduler,debugBelch("sched: "););
+#endif
+
+ schedulePostRunThread();
+
+ ready_to_gc = rtsFalse;
+
+ switch (ret) {
+ case HeapOverflow:
+ ready_to_gc = scheduleHandleHeapOverflow(cap,t);
+ break;
+
+ case StackOverflow:
+ scheduleHandleStackOverflow(t);
+ break;
+
+ case ThreadYielding:
+ if (scheduleHandleYield(t, prev_what_next)) {
+ // shortcut for switching between compiler/interpreter:
+ goto run_thread;
+ }
+ break;
+
+ case ThreadBlocked:
+ scheduleHandleThreadBlocked(t);
+ break;
+
+ case ThreadFinished:
+ if (scheduleHandleThreadFinished(mainThread, cap, t)) return;;
+ break;
+
+ default:
+ barf("schedule: invalid thread return code %d", (int)ret);
+ }
+
+ if (scheduleDoHeapProfile(ready_to_gc)) { ready_to_gc = rtsFalse; }
+ if (ready_to_gc) { scheduleDoGC(rtsFalse); }
+ } /* end of while() */
+
+ IF_PAR_DEBUG(verbose,
+ debugBelch("== Leaving schedule() after having received Finish\n"));
+}
+
+/* ----------------------------------------------------------------------------
+ * Setting up the scheduler loop
+ * ASSUMES: sched_mutex
+ * ------------------------------------------------------------------------- */
+
+static void
+schedulePreLoop(void)
+{
+#if defined(GRAN)
+ /* set up first event to get things going */
+ /* ToDo: assign costs for system setup and init MainTSO ! */
+ new_event(CurrentProc, CurrentProc, CurrentTime[CurrentProc],
+ ContinueThread,
+ CurrentTSO, (StgClosure*)NULL, (rtsSpark*)NULL);
+
+ IF_DEBUG(gran,
+ debugBelch("GRAN: Init CurrentTSO (in schedule) = %p\n",
+ CurrentTSO);
+ G_TSO(CurrentTSO, 5));
+
+ if (RtsFlags.GranFlags.Light) {
+ /* Save current time; GranSim Light only */
+ CurrentTSO->gran.clock = CurrentTime[CurrentProc];
+ }
+#endif
+}
+
+/* ----------------------------------------------------------------------------
+ * Start any pending signal handlers
+ * ASSUMES: sched_mutex
+ * ------------------------------------------------------------------------- */
+
+static void
+scheduleStartSignalHandlers(void)
+{
+#if defined(RTS_USER_SIGNALS) && !defined(RTS_SUPPORTS_THREADS)
+ if (signals_pending()) {
+ RELEASE_LOCK(&sched_mutex); /* ToDo: kill */
+ startSignalHandlers();
+ ACQUIRE_LOCK(&sched_mutex);
+ }
+#endif
+}
+
+/* ----------------------------------------------------------------------------
+ * Check for blocked threads that can be woken up.
+ * ASSUMES: sched_mutex
+ * ------------------------------------------------------------------------- */
+
+static void
+scheduleCheckBlockedThreads(void)
+{
+ //
+ // Check whether any waiting threads need to be woken up. If the
+ // run queue is empty, and there are no other tasks running, we
+ // can wait indefinitely for something to happen.
+ //
+ if ( !EMPTY_QUEUE(blocked_queue_hd) || !EMPTY_QUEUE(sleeping_queue) )
+ {
+#if defined(RTS_SUPPORTS_THREADS)
+ // We shouldn't be here...
+ barf("schedule: awaitEvent() in threaded RTS");
+#else
+ awaitEvent( EMPTY_RUN_QUEUE() && !blackholes_need_checking );
+#endif
+ }
+}
+
+
+/* ----------------------------------------------------------------------------
+ * Check for threads blocked on BLACKHOLEs that can be woken up
+ * ASSUMES: sched_mutex
+ * ------------------------------------------------------------------------- */
+static void
+scheduleCheckBlackHoles( void )
+{
+ if ( blackholes_need_checking )
+ {
+ checkBlackHoles();
+ blackholes_need_checking = rtsFalse;
+ }
+}
+
+/* ----------------------------------------------------------------------------
+ * Detect deadlock conditions and attempt to resolve them.
+ * ASSUMES: sched_mutex
+ * ------------------------------------------------------------------------- */
+
+static void
+scheduleDetectDeadlock()
+{
+
+#if defined(PARALLEL_HASKELL)
+ // ToDo: add deadlock detection in GUM (similar to SMP) -- HWL
+ return;
+#endif
+
+ /*
+ * Detect deadlock: when we have no threads to run, there are no
+ * threads blocked, waiting for I/O, or sleeping, and all the
+ * other tasks are waiting for work, we must have a deadlock of
+ * some description.
+ */
+ if ( EMPTY_THREAD_QUEUES() )
+ {
+#if defined(RTS_SUPPORTS_THREADS)
+ /*
+ * In the threaded RTS, we only check for deadlock if there
+ * has been no activity in a complete timeslice. This means
+ * we won't eagerly start a full GC just because we don't have
+ * any threads to run currently.
+ */
+ if (recent_activity != ACTIVITY_INACTIVE) return;
+#endif
+
+ IF_DEBUG(scheduler, sched_belch("deadlocked, forcing major GC..."));
+
+ // Garbage collection can release some new threads due to
+ // either (a) finalizers or (b) threads resurrected because
+ // they are unreachable and will therefore be sent an
+ // exception. Any threads thus released will be immediately
+ // runnable.
+
+ scheduleDoGC( rtsTrue/*force major GC*/ );
+ recent_activity = ACTIVITY_DONE_GC;
+ if ( !EMPTY_RUN_QUEUE() ) return;
+
+#if defined(RTS_USER_SIGNALS) && !defined(RTS_SUPPORTS_THREADS)
+ /* If we have user-installed signal handlers, then wait
+ * for signals to arrive rather then bombing out with a
+ * deadlock.
+ */
+ if ( anyUserHandlers() ) {
+ IF_DEBUG(scheduler,
+ sched_belch("still deadlocked, waiting for signals..."));
+
+ awaitUserSignals();
+
+ if (signals_pending()) {
+ RELEASE_LOCK(&sched_mutex);
+ startSignalHandlers();
+ ACQUIRE_LOCK(&sched_mutex);
+ }
+
+ // either we have threads to run, or we were interrupted:
+ ASSERT(!EMPTY_RUN_QUEUE() || interrupted);
+ }
+#endif
+
+#if !defined(RTS_SUPPORTS_THREADS)
+ /* Probably a real deadlock. Send the current main thread the
+ * Deadlock exception (or in the SMP build, send *all* main
+ * threads the deadlock exception, since none of them can make
+ * progress).
+ */
+ {
+ StgMainThread *m;
+ m = main_threads;
+ switch (m->tso->why_blocked) {
+ case BlockedOnSTM:
+ case BlockedOnBlackHole:
+ case BlockedOnException:
+ case BlockedOnMVar:
+ raiseAsync(m->tso, (StgClosure *)NonTermination_closure);
+ return;
+ default:
+ barf("deadlock: main thread blocked in a strange way");
+ }
+ }
+#endif
+ }
+}
+
+/* ----------------------------------------------------------------------------
+ * Process an event (GRAN only)
+ * ------------------------------------------------------------------------- */
+
+#if defined(GRAN)
+static StgTSO *
+scheduleProcessEvent(rtsEvent *event)
+{
+ StgTSO *t;
+
+ if (RtsFlags.GranFlags.Light)
+ GranSimLight_enter_system(event, &ActiveTSO); // adjust ActiveTSO etc
+
+ /* adjust time based on time-stamp */
+ if (event->time > CurrentTime[CurrentProc] &&
+ event->evttype != ContinueThread)
+ CurrentTime[CurrentProc] = event->time;
+
+ /* Deal with the idle PEs (may issue FindWork or MoveSpark events) */
+ if (!RtsFlags.GranFlags.Light)
+ handleIdlePEs();
+
+ IF_DEBUG(gran, debugBelch("GRAN: switch by event-type\n"));
+
+ /* main event dispatcher in GranSim */
+ switch (event->evttype) {
+ /* Should just be continuing execution */
+ case ContinueThread:
+ IF_DEBUG(gran, debugBelch("GRAN: doing ContinueThread\n"));
+ /* ToDo: check assertion
+ ASSERT(run_queue_hd != (StgTSO*)NULL &&
+ run_queue_hd != END_TSO_QUEUE);
+ */