/* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.77 2000/08/23 12:51:03 simonmar Exp $
+ * $Id: Schedule.c,v 1.79 2000/10/10 09:12:19 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
StgTSO *run_queue_hd, *run_queue_tl;
StgTSO *blocked_queue_hd, *blocked_queue_tl;
+StgTSO *sleeping_queue; /* perhaps replace with a hash table? */
#endif
*/
if (interrupted) {
IF_DEBUG(scheduler, sched_belch("interrupted"));
- for (t = run_queue_hd; t != END_TSO_QUEUE; t = t->link) {
- deleteThread(t);
- }
- for (t = blocked_queue_hd; t != END_TSO_QUEUE; t = t->link) {
- deleteThread(t);
- }
- run_queue_hd = run_queue_tl = END_TSO_QUEUE;
- blocked_queue_hd = blocked_queue_tl = END_TSO_QUEUE;
+ deleteAllThreads();
interrupted = rtsFalse;
was_interrupted = rtsTrue;
}
* ToDo: what if another client comes along & requests another
* main thread?
*/
- if (blocked_queue_hd != END_TSO_QUEUE) {
+ if (blocked_queue_hd != END_TSO_QUEUE || sleeping_queue != END_TSO_QUEUE) {
awaitEvent(
(run_queue_hd == END_TSO_QUEUE)
#ifdef SMP
#ifdef SMP
if (blocked_queue_hd == END_TSO_QUEUE
&& run_queue_hd == END_TSO_QUEUE
+ && sleeping_queue == END_TSO_QUEUE
&& (n_free_capabilities == RtsFlags.ParFlags.nNodes))
{
IF_DEBUG(scheduler, sched_belch("deadlocked, checking for black holes..."));
}
#else /* ! SMP */
if (blocked_queue_hd == END_TSO_QUEUE
- && run_queue_hd == END_TSO_QUEUE)
+ && run_queue_hd == END_TSO_QUEUE
+ && sleeping_queue == END_TSO_QUEUE)
{
IF_DEBUG(scheduler, sched_belch("deadlocked, checking for black holes..."));
detectBlackHoles();
*/
if (RtsFlags.ConcFlags.ctxtSwitchTicks == 0
&& (run_queue_hd != END_TSO_QUEUE
- || blocked_queue_hd != END_TSO_QUEUE))
+ || blocked_queue_hd != END_TSO_QUEUE
+ || sleeping_queue != END_TSO_QUEUE))
context_switch = 1;
else
context_switch = 0;
} /* end of while(1) */
}
-/* A hack for Hugs concurrency support. Needs sanitisation (?) */
+/* ---------------------------------------------------------------------------
+ * deleteAllThreads(): kill all the live threads.
+ *
+ * This is used when we catch a user interrupt (^C), before performing
+ * any necessary cleanups and running finalizers.
+ * ------------------------------------------------------------------------- */
+
void deleteAllThreads ( void )
{
StgTSO* t;
- IF_DEBUG(scheduler,sched_belch("deleteAllThreads()"));
+ IF_DEBUG(scheduler,sched_belch("deleting all threads"));
for (t = run_queue_hd; t != END_TSO_QUEUE; t = t->link) {
- deleteThread(t);
+ deleteThread(t);
}
for (t = blocked_queue_hd; t != END_TSO_QUEUE; t = t->link) {
- deleteThread(t);
+ deleteThread(t);
+ }
+ for (t = sleeping_queue; t != END_TSO_QUEUE; t = t->link) {
+ deleteThread(t);
}
run_queue_hd = run_queue_tl = END_TSO_QUEUE;
blocked_queue_hd = blocked_queue_tl = END_TSO_QUEUE;
+ sleeping_queue = END_TSO_QUEUE;
}
/* startThread and insertThread are now in GranSim.c -- HWL */
blocked_queue_hds[i] = END_TSO_QUEUE;
blocked_queue_tls[i] = END_TSO_QUEUE;
ccalling_threadss[i] = END_TSO_QUEUE;
+ sleeping_queue = END_TSO_QUEUE;
}
#else
run_queue_hd = END_TSO_QUEUE;
run_queue_tl = END_TSO_QUEUE;
blocked_queue_hd = END_TSO_QUEUE;
blocked_queue_tl = END_TSO_QUEUE;
+ sleeping_queue = END_TSO_QUEUE;
#endif
suspended_ccalling_threads = END_TSO_QUEUE;
i++;
for (q = blocked_queue_hd; q != END_TSO_QUEUE; q = q->link)
i++;
+ for (q = sleeping_queue; q != END_TSO_QUEUE; q = q->link)
+ i++;
return i;
}
while (blocked_queue_hd != END_TSO_QUEUE) {
waitThread ( blocked_queue_hd, NULL );
}
+ while (sleeping_queue != END_TSO_QUEUE) {
+ waitThread ( blocked_queue_hd, NULL );
+ }
} while
(blocked_queue_hd != END_TSO_QUEUE ||
- run_queue_hd != END_TSO_QUEUE);
+ run_queue_hd != END_TSO_QUEUE ||
+ sleeping_queue != END_TSO_QUEUE);
}
SchedulerStatus
- all the threads on the runnable queue
- all the threads on the blocked queue
+ - all the threads on the sleeping queue
- all the thread currently executing a _ccall_GC
- all the "main threads"
blocked_queue_hd = (StgTSO *)MarkRoot((StgClosure *)blocked_queue_hd);
blocked_queue_tl = (StgTSO *)MarkRoot((StgClosure *)blocked_queue_tl);
}
+
+ if (sleeping_queue != END_TSO_QUEUE) {
+ sleeping_queue = (StgTSO *)MarkRoot((StgClosure *)sleeping_queue);
+ }
#endif
for (m = main_threads; m != NULL; m = m->link) {
Wake up a queue that was blocked on some resource.
------------------------------------------------------------------------ */
-/* ToDo: check push_on_run_queue vs. PUSH_ON_RUN_QUEUE */
-
#if defined(GRAN)
static inline void
unblockCount ( StgBlockingQueueElement *bqe, StgClosure *node )
barf("unblockThread (Exception): TSO not found");
}
- case BlockedOnDelay:
case BlockedOnRead:
case BlockedOnWrite:
{
barf("unblockThread (I/O): TSO not found");
}
+ case BlockedOnDelay:
+ {
+ StgBlockingQueueElement *prev = NULL;
+ for (t = (StgBlockingQueueElement *)sleeping_queue; t != END_BQ_QUEUE;
+ prev = t, t = t->link) {
+ if (t == (StgBlockingQueueElement *)tso) {
+ if (prev == NULL) {
+ sleeping_queue = (StgTSO *)t->link;
+ } else {
+ prev->link = t->link;
+ }
+ goto done;
+ }
+ }
+ barf("unblockThread (I/O): TSO not found");
+ }
+
default:
barf("unblockThread");
}
barf("unblockThread (Exception): TSO not found");
}
- case BlockedOnDelay:
case BlockedOnRead:
case BlockedOnWrite:
{
barf("unblockThread (I/O): TSO not found");
}
+ case BlockedOnDelay:
+ {
+ StgTSO *prev = NULL;
+ for (t = sleeping_queue; t != END_TSO_QUEUE;
+ prev = t, t = t->link) {
+ if (t == tso) {
+ if (prev == NULL) {
+ sleeping_queue = t->link;
+ } else {
+ prev->link = t->link;
+ }
+ goto done;
+ }
+ }
+ barf("unblockThread (I/O): TSO not found");
+ }
+
default:
barf("unblockThread");
}
tso->su = (StgUpdateFrame *)(sp+1);
tso->sp = sp;
return;
-
+
default:
barf("raiseAsync");
}
{
switch (tso->why_blocked) {
case BlockedOnRead:
- fprintf(stderr,"blocked on read from fd %d", tso->block_info.fd);
+ fprintf(stderr,"is blocked on read from fd %d", tso->block_info.fd);
break;
case BlockedOnWrite:
- fprintf(stderr,"blocked on write to fd %d", tso->block_info.fd);
+ fprintf(stderr,"is blocked on write to fd %d", tso->block_info.fd);
break;
case BlockedOnDelay:
-#if defined(HAVE_SETITIMER) || defined(mingw32_TARGET_OS)
- fprintf(stderr,"blocked on delay of %d ms", tso->block_info.delay);
-#else
- fprintf(stderr,"blocked on delay of %d ms",
- tso->block_info.target - getourtimeofday());
-#endif
+ fprintf(stderr,"is blocked until %d", tso->block_info.target);
break;
case BlockedOnMVar:
- fprintf(stderr,"blocked on an MVar");
+ fprintf(stderr,"is blocked on an MVar");
break;
case BlockedOnException:
- fprintf(stderr,"blocked on delivering an exception to thread %d",
+ fprintf(stderr,"is blocked on delivering an exception to thread %d",
tso->block_info.tso->id);
break;
case BlockedOnBlackHole:
- fprintf(stderr,"blocked on a black hole");
+ fprintf(stderr,"is blocked on a black hole");
break;
case NotBlocked:
- fprintf(stderr,"not blocked");
+ fprintf(stderr,"is not blocked");
break;
#if defined(PAR)
case BlockedOnGA:
- fprintf(stderr,"blocked on global address; local FM_BQ is %p (%s)",
+ fprintf(stderr,"is blocked on global address; local FM_BQ is %p (%s)",
tso->block_info.closure, info_type(tso->block_info.closure));
break;
case BlockedOnGA_NoSend:
- fprintf(stderr,"blocked on global address (no send); local FM_BQ is %p (%s)",
+ fprintf(stderr,"is blocked on global address (no send); local FM_BQ is %p (%s)",
tso->block_info.closure, info_type(tso->block_info.closure));
break;
#endif
sched_belch("all threads:");
for (t = all_threads; t != END_TSO_QUEUE; t = t->global_link) {
- fprintf(stderr, "\tthread %d is ", t->id);
+ fprintf(stderr, "\tthread %d ", t->id);
printThreadStatus(t);
fprintf(stderr,"\n");
}
projects / ghc-hetmet.git / blobdiff