/* -----------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.18 1999/03/17 13:19:24 simonm Exp $
+ * $Id: Schedule.c,v 1.25 1999/09/10 11:11:51 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?
StgTSO *dest;
if (tso->stack_size >= tso->max_stack_size) {
-#ifdef 0
+#if 0
/* If we're debugging, just print out the top of the stack */
printStackChunk(tso->sp, stg_min(tso->stack+tso->stack_size,
tso->sp+64));
#endif
+#ifdef INTERPRETER
+ fprintf(stderr, "fatal: stack overflow in Hugs; aborting\n" );
+ exit(1);
+#else
/* Send this thread the StackOverflow exception */
raiseAsync(tso, (StgClosure *)&stackOverflow_closure);
+#endif
return tso;
}
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;
- 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));
+ 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;
+}
+
+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 BlockedOnRead:
+ case BlockedOnWrite:
+ case BlockedOnDelay:
+ /* ToDo */
+ barf("unblockThread {read,write,delay}");
+
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;