/* -----------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.20 1999/04/27 10:59:31 sewardj Exp $
+ * $Id: Schedule.c,v 1.26 1999/10/04 16:13:18 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
static void unblockThread(StgTSO *tso);
/* -----------------------------------------------------------------------------
+ * Comparing Thread ids.
+ *
+ * This is used from STG land in the implementation of the
+ * instances of Eq/Ord for ThreadIds.
+ * -------------------------------------------------------------------------- */
+
+int cmp_thread(const StgTSO *tso1, const StgTSO *tso2)
+{
+ StgThreadID id1 = tso1->id;
+ StgThreadID id2 = tso2->id;
+
+ if (id1 < id2) return (-1);
+ if (id1 > id2) return 1;
+ return 0;
+}
+
+/* -----------------------------------------------------------------------------
Create a new thread.
The new thread starts with the given stack size. Before the
SET_INFO(tso,&TSO_info);
tso->whatNext = ThreadEnterGHC;
tso->id = next_thread_id++;
- tso->blocked_on = NULL;
+ tso->why_blocked = NotBlocked;
tso->splim = (P_)&(tso->stack) + RESERVED_STACK_WORDS;
tso->stack_size = stack_size;
/* If we have more threads on the run queue, set up a context
* switch at some point in the future.
*/
- if (run_queue_hd != END_TSO_QUEUE) {
+ if (run_queue_hd != END_TSO_QUEUE || blocked_queue_hd != END_TSO_QUEUE) {
context_switch = 1;
} else {
context_switch = 0;
break;
case ThreadBlocked:
- IF_DEBUG(scheduler,belch("Thread %ld stopped, blocking\n", t->id));
+ IF_DEBUG(scheduler,
+ fprintf(stderr, "Thread %d stopped, ", t->id);
+ printThreadBlockage(t);
+ fprintf(stderr, "\n"));
threadPaused(t);
/* assume the thread has put itself on some blocked queue
* somewhere.
}
next_thread:
+ /* Checked whether any waiting threads need to be woken up.
+ * If the run queue is empty, we can wait indefinitely for
+ * something to happen.
+ */
+ if (blocked_queue_hd != END_TSO_QUEUE) {
+ awaitEvent(run_queue_hd == END_TSO_QUEUE);
+ }
+
t = run_queue_hd;
if (t != END_TSO_QUEUE) {
run_queue_hd = t->link;
}
}
- if (blocked_queue_hd != END_TSO_QUEUE) {
- return AllBlocked;
- } else {
- return Deadlock;
+ /* If we got to here, then we ran out of threads to run, but the
+ * main thread hasn't finished yet. It must be blocked on an MVar
+ * or a black hole somewhere, so we return deadlock.
+ */
+ return Deadlock;
+}
+
+/* -----------------------------------------------------------------------------
+ Debugging: why is a thread blocked
+ -------------------------------------------------------------------------- */
+
+#ifdef DEBUG
+void printThreadBlockage(StgTSO *tso)
+{
+ switch (tso->why_blocked) {
+ case BlockedOnRead:
+ fprintf(stderr,"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);
+ break;
+ case BlockedOnDelay:
+ fprintf(stderr,"blocked on delay of %d ms", tso->block_info.delay);
+ break;
+ case BlockedOnMVar:
+ fprintf(stderr,"blocked on an MVar");
+ break;
+ case BlockedOnBlackHole:
+ fprintf(stderr,"blocked on a black hole");
+ break;
+ case NotBlocked:
+ fprintf(stderr,"not blocked");
+ break;
}
}
+#endif
/* -----------------------------------------------------------------------------
Where are the roots that we know about?
tso->whatNext = ThreadKilled;
tso->sp = (P_)&(tso->stack[tso->stack_size]);
tso->su = (StgUpdateFrame *)tso->sp;
- tso->blocked_on = NULL;
+ tso->why_blocked = NotBlocked;
dest->mut_link = NULL;
IF_DEBUG(sanity,checkTSO(tso));
}
/* -----------------------------------------------------------------------------
- Wake up a queue that was blocked on some resource (usually a
- computation in progress).
+ Wake up a queue that was blocked on some resource.
-------------------------------------------------------------------------- */
-void awaken_blocked_queue(StgTSO *q)
+StgTSO *unblockOne(StgTSO *tso)
{
- StgTSO *tso;
+ StgTSO *next;
+
+ ASSERT(get_itbl(tso)->type == TSO);
+ ASSERT(tso->why_blocked != NotBlocked);
+ tso->why_blocked = NotBlocked;
+ next = tso->link;
+ tso->link = END_TSO_QUEUE;
+ PUSH_ON_RUN_QUEUE(tso);
+ IF_DEBUG(scheduler,belch("Waking up thread %ld", tso->id));
+ return next;
+}
- while (q != END_TSO_QUEUE) {
- ASSERT(get_itbl(q)->type == TSO);
- tso = q;
- q = tso->link;
- PUSH_ON_RUN_QUEUE(tso);
- tso->blocked_on = NULL;
- IF_DEBUG(scheduler,belch("Waking up thread %ld", tso->id));
+void awakenBlockedQueue(StgTSO *tso)
+{
+ while (tso != END_TSO_QUEUE) {
+ tso = unblockOne(tso);
}
}
{
StgTSO *t, **last;
- if (tso->blocked_on == NULL) {
- return; /* not blocked */
- }
+ switch (tso->why_blocked) {
- switch (get_itbl(tso->blocked_on)->type) {
+ case NotBlocked:
+ return; /* not blocked */
- case MVAR:
+ case BlockedOnMVar:
+ ASSERT(get_itbl(tso->block_info.closure)->type == MVAR);
{
StgTSO *last_tso = END_TSO_QUEUE;
- StgMVar *mvar = (StgMVar *)(tso->blocked_on);
+ StgMVar *mvar = (StgMVar *)(tso->block_info.closure);
last = &mvar->head;
for (t = mvar->head; t != END_TSO_QUEUE;
barf("unblockThread (MVAR): TSO not found");
}
- case BLACKHOLE_BQ:
+ case BlockedOnBlackHole:
+ ASSERT(get_itbl(tso->block_info.closure)->type == BLACKHOLE_BQ);
{
- StgBlockingQueue *bq = (StgBlockingQueue *)(tso->blocked_on);
+ StgBlockingQueue *bq = (StgBlockingQueue *)(tso->block_info.closure);
last = &bq->blocking_queue;
for (t = bq->blocking_queue; t != END_TSO_QUEUE;
barf("unblockThread (BLACKHOLE): TSO not found");
}
+ case BlockedOnDelay:
+ case BlockedOnRead:
+ case BlockedOnWrite:
+ {
+ last = &blocked_queue_hd;
+ for (t = blocked_queue_hd; t != END_TSO_QUEUE;
+ last = &t->link, t = t->link) {
+ if (t == tso) {
+ *last = tso->link;
+ if (blocked_queue_tl == t) {
+ blocked_queue_tl = tso->link;
+ }
+ goto done;
+ }
+ }
+ barf("unblockThread (I/O): TSO not found");
+ }
+
default:
barf("unblockThread");
}
done:
tso->link = END_TSO_QUEUE;
- tso->blocked_on = NULL;
+ tso->why_blocked = NotBlocked;
+ tso->block_info.closure = NULL;
PUSH_ON_RUN_QUEUE(tso);
}
* handler in this frame.
*/
ap = (StgAP_UPD *)allocate(sizeofW(StgPAP) + 1);
- TICK_ALLOC_THK(2,0);
+ TICK_ALLOC_UPD_PAP(2,0);
SET_HDR(ap,&PAP_info,cf->header.prof.ccs);
ap->n_args = 1;
* fun field.
*/
ap = (StgAP_UPD *)allocate(AP_sizeW(words));
- TICK_ALLOC_THK(words+1,0);
ASSERT(words >= 0);
case UPDATE_FRAME:
{
SET_HDR(ap,&AP_UPD_info,su->header.prof.ccs /* ToDo */);
+ TICK_ALLOC_UP_THK(words+1,0);
IF_DEBUG(scheduler,
fprintf(stderr, "Updating ");
* layout's the same.
*/
SET_HDR(ap,&PAP_info,su->header.prof.ccs /* ToDo */);
+ TICK_ALLOC_UPD_PAP(words+1,0);
/* now build o = FUN(catch,ap,handler) */
o = (StgClosure *)allocate(sizeofW(StgClosure)+2);
- TICK_ALLOC_THK(2,0);
+ TICK_ALLOC_FUN(2,0);
SET_HDR(o,&catch_info,su->header.prof.ccs /* ToDo */);
o->payload[0] = (StgClosure *)ap;
o->payload[1] = cf->handler;
StgClosure* o;
SET_HDR(ap,&PAP_info,su->header.prof.ccs /* ToDo */);
+ TICK_ALLOC_UPD_PAP(words+1,0);
/* now build o = FUN(seq,ap) */
o = (StgClosure *)allocate(sizeofW(StgClosure)+1);
- TICK_ALLOC_THK(1,0);
+ TICK_ALLOC_SE_THK(1,0);
SET_HDR(o,&seq_info,su->header.prof.ccs /* ToDo */);
payloadCPtr(o,0) = (StgClosure *)ap;
projects / ghc-hetmet.git / blobdiff