*/
void grabCapability(Capability** cap)
{
-#ifdef RTS_SUPPORTS_THREADS
- ASSERT(rts_n_free_capabilities > 0);
-#endif
#if !defined(SMP)
+ ASSERT(rts_n_free_capabilities == 1);
rts_n_free_capabilities = 0;
*cap = &MainCapability;
handleSignalsInThisThread();
rts_n_free_capabilities--;
#endif
#ifdef RTS_SUPPORTS_THREADS
- IF_DEBUG(scheduler,
- fprintf(stderr,"worker thread (%p): got capability\n",
- osThreadId()));
+ IF_DEBUG(scheduler, sched_belch("worker: got capability"));
#endif
}
#endif
rts_n_waiting_workers--;
signalCondition(&returning_worker_cond);
+ IF_DEBUG(scheduler, sched_belch("worker: released capability to returning worker"));
} else /*if ( !EMPTY_RUN_QUEUE() )*/ {
#if defined(SMP)
cap->link = free_capabilities;
}
#endif
#ifdef RTS_SUPPORTS_THREADS
- IF_DEBUG(scheduler,
- fprintf(stderr,"worker thread (%p): released capability\n",
- osThreadId()));
+ IF_DEBUG(scheduler, sched_belch("worker: released capability"));
#endif
return;
}
void
grabReturnCapability(Mutex* pMutex, Capability** pCap)
{
- IF_DEBUG(scheduler,
- fprintf(stderr,"worker (%p): returning, waiting for lock.\n", osThreadId()));
- IF_DEBUG(scheduler,
- fprintf(stderr,"worker (%p): returning; workers waiting: %d\n",
- osThreadId(), rts_n_waiting_workers));
+ IF_DEBUG(scheduler,
+ sched_belch("worker: returning; workers waiting: %d",
+ rts_n_waiting_workers));
if ( noCapabilities() ) {
rts_n_waiting_workers++;
wakeBlockedWorkerThread();
yieldToReturningWorker(Mutex* pMutex, Capability** pCap, Condition* pThreadCond)
{
if ( rts_n_waiting_workers > 0 ) {
- IF_DEBUG(scheduler,
- fprintf(stderr,"worker thread (%p): giving up RTS token\n", osThreadId()));
+ IF_DEBUG(scheduler, sched_belch("worker: giving up capability"));
releaseCapability(*pCap);
/* And wait for work */
waitForWorkCapability(pMutex, pCap, pThreadCond);
IF_DEBUG(scheduler,
- fprintf(stderr,"worker thread (%p): got back RTS token (after yieldToReturningWorker)\n",
- osThreadId()));
+ sched_belch("worker: got back capability (after yieldToReturningWorker)"));
}
return;
}
#ifdef SMP
#error SMP version not implemented
#endif
- IF_DEBUG(scheduler,
- fprintf(stderr,"worker thread (%p): wait for cap (cond: %p)\n",
- osThreadId(),pThreadCond));
while ( noCapabilities() || (passingCapability && passTarget != pThreadCond)) {
+ IF_DEBUG(scheduler,
+ sched_belch("worker: wait for capability (cond: %p)",
+ pThreadCond));
if(pThreadCond)
{
waitCondition(pThreadCond, pMutex);
- IF_DEBUG(scheduler,
- fprintf(stderr,"worker thread (%p): get passed capability\n",
- osThreadId()));
+ IF_DEBUG(scheduler, sched_belch("worker: get passed capability"));
}
else
{
rts_n_waiting_tasks++;
waitCondition(&thread_ready_cond, pMutex);
rts_n_waiting_tasks--;
- IF_DEBUG(scheduler,
- fprintf(stderr,"worker thread (%p): get normal capability\n",
- osThreadId()));
+ IF_DEBUG(scheduler, sched_belch("worker: get normal capability"));
}
}
passingCapability = rtsFalse;
rts_n_free_capabilities = 1;
signalCondition(pTargetThreadCond);
passTarget = pTargetThreadCond;
- passingCapability = rtsTrue;
- IF_DEBUG(scheduler,
- fprintf(stderr,"worker thread (%p): passCapability\n",
- osThreadId()));
+ passingCapability = rtsTrue;
+ IF_DEBUG(scheduler, sched_belch("worker: passCapability"));
}
/*
startSchedulerTaskIfNecessary();
passTarget = NULL;
passingCapability = rtsTrue;
- IF_DEBUG(scheduler,
- fprintf(stderr,"worker thread (%p): passCapabilityToWorker\n",
- osThreadId()));
+ IF_DEBUG(scheduler, sched_belch("worker: passCapabilityToWorker"));
}
free_capabilities = cap;
rts_n_free_capabilities = n;
returning_capabilities = NULL;
- IF_DEBUG(scheduler,fprintf(stderr,"scheduler: Allocated %d capabilities\n", n_free_capabilities););
+ IF_DEBUG(scheduler,
+ sched_belch("allocated %d capabilities", n_free_capabilities));
}
#endif /* SMP */
/* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.181 2003/12/05 09:50:39 stolz Exp $
+ * $Id: Schedule.c,v 1.182 2003/12/12 16:35:20 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
static void detectBlackHoles ( void );
-#ifdef DEBUG
-static void sched_belch(char *s, ...);
-#endif
-
#if defined(RTS_SUPPORTS_THREADS)
/* ToDo: carefully document the invariants that go together
* with these synchronisation objects.
ACQUIRE_LOCK(&sched_mutex);
#if defined(RTS_SUPPORTS_THREADS)
- /* in the threaded case, the capability is either passed in via the initialCapability
- parameter, or initialized inside the scheduler loop */
-
- IF_DEBUG(scheduler,
- fprintf(stderr,"### NEW SCHEDULER LOOP in os thread %u(%p)\n",
- osThreadId(), osThreadId()));
+ //
+ // in the threaded case, the capability is either passed in via the
+ // initialCapability parameter, or initialized inside the scheduler
+ // loop
+ //
IF_DEBUG(scheduler,
- fprintf(stderr,"### main thread: %p\n",mainThread));
- IF_DEBUG(scheduler,
- fprintf(stderr,"### initial cap: %p\n",initialCapability));
+ sched_belch("### NEW SCHEDULER LOOP (main thr: %p, cap: %p)",
+ mainThread, initialCapability);
+ );
#else
/* simply initialise it in the non-threaded case */
grabCapability(&cap);
while (!receivedFinish) { /* set by processMessages */
/* when receiving PP_FINISH message */
-#else
+
+#else // everything except GRAN and PAR
while (1) {
#endif
- IF_DEBUG(scheduler, printAllThreads());
+ IF_DEBUG(scheduler, printAllThreads());
#if defined(RTS_SUPPORTS_THREADS)
- /* Check to see whether there are any worker threads
- waiting to deposit external call results. If so,
- yield our capability... if we have a capability, that is. */
- if(cap)
- yieldToReturningWorker(&sched_mutex, &cap,
- mainThread ? &mainThread->bound_thread_cond : NULL);
-
- /* If we do not currently hold a capability, we wait for one */
- if(!cap)
- {
- waitForWorkCapability(&sched_mutex, &cap,
- mainThread ? &mainThread->bound_thread_cond : NULL);
- IF_DEBUG(scheduler, sched_belch("worker thread (osthread %p): got cap",
- osThreadId()));
+ //
+ // Check to see whether there are any worker threads
+ // waiting to deposit external call results. If so,
+ // yield our capability... if we have a capability, that is.
+ //
+ if (cap != NULL) {
+ yieldToReturningWorker(&sched_mutex, &cap,
+ mainThread ? &mainThread->bound_thread_cond
+ : NULL);
+ }
+
+ // If we do not currently hold a capability, we wait for one
+ if (cap == NULL) {
+ waitForWorkCapability(&sched_mutex, &cap,
+ mainThread ? &mainThread->bound_thread_cond
+ : NULL);
}
#endif
- /* If we're interrupted (the user pressed ^C, or some other
- * termination condition occurred), kill all the currently running
- * threads.
- */
+ //
+ // If we're interrupted (the user pressed ^C, or some other
+ // termination condition occurred), kill all the currently running
+ // threads.
+ //
if (interrupted) {
- IF_DEBUG(scheduler, sched_belch("interrupted"));
- interrupted = rtsFalse;
- was_interrupted = rtsTrue;
+ IF_DEBUG(scheduler, sched_belch("interrupted"));
+ interrupted = rtsFalse;
+ was_interrupted = rtsTrue;
#if defined(RTS_SUPPORTS_THREADS)
- // In the threaded RTS, deadlock detection doesn't work,
- // so just exit right away.
- prog_belch("interrupted");
- releaseCapability(cap);
- RELEASE_LOCK(&sched_mutex);
- shutdownHaskellAndExit(EXIT_SUCCESS);
+ // In the threaded RTS, deadlock detection doesn't work,
+ // so just exit right away.
+ prog_belch("interrupted");
+ releaseCapability(cap);
+ RELEASE_LOCK(&sched_mutex);
+ shutdownHaskellAndExit(EXIT_SUCCESS);
#else
- deleteAllThreads();
+ deleteAllThreads();
#endif
}
- /* Go through the list of main threads and wake up any
- * clients whose computations have finished. ToDo: this
- * should be done more efficiently without a linear scan
- * of the main threads list, somehow...
- */
+ //
+ // Go through the list of main threads and wake up any
+ // clients whose computations have finished. ToDo: this
+ // should be done more efficiently without a linear scan
+ // of the main threads list, somehow...
+ //
#if defined(RTS_SUPPORTS_THREADS)
{
StgMainThread *m, **prev;
if (m->tso->what_next == ThreadComplete
|| m->tso->what_next == ThreadKilled)
{
- if(m == mainThread)
+ if (m == mainThread)
{
- if(m->tso->what_next == ThreadComplete)
+ if (m->tso->what_next == ThreadComplete)
{
if (m->ret)
{
}
else
{
- // The current OS thread can not handle the fact that the Haskell
- // thread "m" has ended.
- // "m" is bound; the scheduler loop in it's bound OS thread has
- // to return, so let's pass our capability directly to that thread.
- passCapability(&sched_mutex, cap, &m->bound_thread_cond);
- cap = NULL;
+ // The current OS thread can not handle the fact that
+ // the Haskell thread "m" has ended. "m" is bound;
+ // the scheduler loop in it's bound OS thread has to
+ // return, so let's pass our capability directly to
+ // that thread.
+ passCapability(&sched_mutex, cap, &m->bound_thread_cond);
+ cap = NULL;
}
}
}
}
- if(!cap) // If we gave our capability away,
- continue; // go to the top to get it back
+ // If we gave our capability away, go to the top to get it back
+ if (cap == NULL) {
+ continue;
+ }
#else /* not threaded */
}
#endif
+
+#if 0 /* defined(SMP) */
/* Top up the run queue from our spark pool. We try to make the
* number of threads in the run queue equal to the number of
* free capabilities.
* Disable spark support in SMP for now, non-essential & requires
* a little bit of work to make it compile cleanly. -- sof 1/02.
*/
-#if 0 /* defined(SMP) */
{
nat n = getFreeCapabilities();
StgTSO *tso = run_queue_hd;
}
#endif // SMP
- /* check for signals each time around the scheduler */
#if defined(RTS_USER_SIGNALS)
+ // check for signals each time around the scheduler
if (signals_pending()) {
RELEASE_LOCK(&sched_mutex); /* ToDo: kill */
startSignalHandlers();
RELEASE_LOCK(&sched_mutex);
return;
}
- IF_DEBUG(scheduler, sched_belch("thread %d: waiting for work", osThreadId()));
+ IF_DEBUG(scheduler, sched_belch("waiting for work"));
waitForWorkCapability(&sched_mutex, &cap, rtsTrue);
- IF_DEBUG(scheduler, sched_belch("thread %d: work now available", osThreadId()));
+ IF_DEBUG(scheduler, sched_belch("work now available"));
}
#else
if ( EMPTY_RUN_QUEUE() ) {
# endif
#else /* !GRAN && !PAR */
- /* grab a thread from the run queue */
+ // grab a thread from the run queue
ASSERT(run_queue_hd != END_TSO_QUEUE);
POP_RUN_QUEUE(t);
+
// Sanity check the thread we're about to run. This can be
// expensive if there is lots of thread switching going on...
IF_DEBUG(sanity,checkTSO(t));
if(m == mainThread)
{
IF_DEBUG(scheduler,
- fprintf(stderr,"### Running TSO %p in bound OS thread %u\n",
- t, osThreadId()));
+ sched_belch("### Running thread %d in bound thread", t->id));
// yes, the Haskell thread is bound to the current native thread
}
else
{
IF_DEBUG(scheduler,
- fprintf(stderr,"### TSO %p bound to other OS thread than %u\n",
- t, osThreadId()));
+ sched_belch("### thread %d bound to another OS thread", t->id));
// no, bound to a different Haskell thread: pass to that thread
PUSH_ON_RUN_QUEUE(t);
passCapability(&sched_mutex,cap,&m->bound_thread_cond);
}
else
{
- // The thread we want to run is not bound.
- if(mainThread == NULL)
- {
- IF_DEBUG(scheduler,
- fprintf(stderr,"### Running TSO %p in worker OS thread %u\n",
- t, osThreadId()));
- // if we are a worker thread,
- // we may run it here
- }
- else
+ if(mainThread != NULL)
+ // The thread we want to run is bound.
{
IF_DEBUG(scheduler,
- fprintf(stderr,"### TSO %p is not appropriate for main thread %p in OS thread %u\n",
- t, mainThread, osThreadId()));
+ sched_belch("### this OS thread cannot run thread %d", t->id));
// no, the current native thread is bound to a different
// Haskell thread, so pass it to any worker thread
PUSH_ON_RUN_QUEUE(t);
ACQUIRE_LOCK(&sched_mutex);
#ifdef RTS_SUPPORTS_THREADS
- IF_DEBUG(scheduler,fprintf(stderr,"scheduler (task %p): ", osThreadId()););
+ IF_DEBUG(scheduler,fprintf(stderr,"sched (task %p): ", osThreadId()););
#elif !defined(GRAN) && !defined(PAR)
- IF_DEBUG(scheduler,fprintf(stderr,"scheduler: "););
+ IF_DEBUG(scheduler,fprintf(stderr,"sched: "););
#endif
t = cap->r.rCurrentTSO;
t->id, whatNext_strs[t->what_next]);
printThreadBlockage(t);
fprintf(stderr, "\n"));
+ fflush(stderr);
/* Only for dumping event to log file
ToDo: do I need this in GranSim, too?
#endif
threadPaused(t);
break;
-
+
case ThreadFinished:
/* Need to check whether this was a main thread, and if so, signal
* the task that started it with the return value. If we have no
/* Preparing to leave the RTS, so ensure there's a native thread/task
waiting to take over.
*/
- IF_DEBUG(scheduler, sched_belch("worker thread (%d, osthread %p): leaving RTS", tok, osThreadId()));
+ IF_DEBUG(scheduler, sched_belch("worker (token %d): leaving RTS", tok));
#endif
/* Other threads _might_ be available for execution; signal this */
ACQUIRE_LOCK(&sched_mutex);
grabReturnCapability(&sched_mutex, &cap);
- IF_DEBUG(scheduler, sched_belch("worker thread (%d, osthread %p): re-entering RTS", tok, osThreadId()));
+ IF_DEBUG(scheduler, sched_belch("worker (token %d): re-entering RTS", tok));
#else
grabCapability(&cap);
#endif
signal the completion of the its work item for the main thread to
see (==> it got stuck waiting.) -- sof 6/02.
*/
- IF_DEBUG(scheduler, sched_belch("waiting for thread (%d)\n", tso->id));
+ IF_DEBUG(scheduler, sched_belch("waiting for thread (%d)", tso->id));
m->link = main_threads;
main_threads = m;
SchedulerStatus stat;
// Precondition: sched_mutex must be held.
- IF_DEBUG(scheduler, sched_belch("== scheduler: new main thread (%d)\n", m->tso->id));
+ IF_DEBUG(scheduler, sched_belch("new main thread (%d)", m->tso->id));
#if defined(RTS_SUPPORTS_THREADS) && !defined(THREADED_RTS)
{ // FIXME: does this still make sense?
#endif
#endif
- IF_DEBUG(scheduler, fprintf(stderr, "== scheduler: main thread (%d) finished\n",
+ IF_DEBUG(scheduler, fprintf(stderr, "== sched: main thread (%d) finished\n",
m->tso->id));
stgFree(m);
new_tso_size = round_to_mblocks(new_tso_size); /* Be MBLOCK-friendly */
new_stack_size = new_tso_size - TSO_STRUCT_SIZEW;
- IF_DEBUG(scheduler, fprintf(stderr,"== scheduler: increasing stack size from %d words to %d.\n", tso->stack_size, new_stack_size));
+ IF_DEBUG(scheduler, fprintf(stderr,"== sched: increasing stack size from %d words to %d.\n", tso->stack_size, new_stack_size));
dest = (StgTSO *)allocate(new_tso_size);
TICK_ALLOC_TSO(new_stack_size,0);
TICK_ALLOC_UP_THK(words+1,0);
IF_DEBUG(scheduler,
- fprintf(stderr, "scheduler: Updating ");
+ fprintf(stderr, "sched: Updating ");
printPtr((P_)((StgUpdateFrame *)frame)->updatee);
fprintf(stderr, " with ");
printObj((StgClosure *)ap);
}
#endif
-static void
+void
sched_belch(char *s, ...)
{
va_list ap;
va_start(ap,s);
-#ifdef SMP
- fprintf(stderr, "scheduler (task %ld): ", osThreadId());
+#ifdef RTS_SUPPORTS_THREADS
+ fprintf(stderr, "sched (task %p): ", osThreadId());
#elif defined(PAR)
fprintf(stderr, "== ");
#else
- fprintf(stderr, "scheduler: ");
+ fprintf(stderr, "sched: ");
#endif
vfprintf(stderr, s, ap);
fprintf(stderr, "\n");
+ fflush(stderr);
va_end(ap);
}