Commit 237ea701 authored by sof's avatar sof
Browse files

[project @ 2002-06-19 20:45:14 by sof]

When handling external call-ins (via the RTS API) in
the multi-threaded case, add the StgMainThread that
the external thread is going to block waiting on
to the main_threads list prior to scheduling the new
worker thread.

Do this by having the scheduler provide a new entry
point, scheduleWaitThread().

Fixes a bug/race condition spotted by Wolfgang Thaller
(see scheduleWaitThread() comment) + enables a little
tidier interface between RtsAPI and Schedule.
parent fe1fb2f2
/* -----------------------------------------------------------------------------
* $Id: SchedAPI.h,v 1.14 2002/02/15 07:37:55 sof Exp $
* $Id: SchedAPI.h,v 1.15 2002/06/19 20:45:17 sof Exp $
*
* (c) The GHC Team 1998
*
......@@ -30,7 +30,7 @@ extern StgTSO *createThread(nat stack_size);
extern void taskStart(void);
#endif
extern void scheduleThread(StgTSO *tso);
extern void scheduleExtThread(StgTSO *tso);
extern SchedulerStatus scheduleWaitThread(StgTSO *tso, /*out*/HaskellObj* ret);
static inline void pushClosure (StgTSO *tso, StgClosure *c) {
tso->sp--;
......
/* ----------------------------------------------------------------------------
* $Id: RtsAPI.c,v 1.34 2002/04/13 05:28:04 sof Exp $
* $Id: RtsAPI.c,v 1.35 2002/06/19 20:45:14 sof Exp $
*
* (c) The GHC Team, 1998-2001
*
......@@ -18,14 +18,6 @@
#include "OSThreads.h"
#include "Schedule.h"
#if defined(THREADED_RTS)
#define WAIT_MAIN_THREAD(tso,ret) waitThread_(tso,ret,rtsFalse)
#define WAIT_EXT_THREAD(tso,ret) waitThread_(tso,ret,rtsTrue)
#else
#define WAIT_MAIN_THREAD(tso,ret) waitThread(tso,ret)
#define WAIT_EXT_THREAD(tso,ret) waitThread(tso,ret)
#endif
#if defined(RTS_SUPPORTS_THREADS)
/* Cheesy locking scheme while waiting for the
* RTS API to change.
......@@ -455,8 +447,7 @@ rts_eval (HaskellObj p, /*out*/HaskellObj *ret)
tso = createGenThread(RtsFlags.GcFlags.initialStkSize, p);
releaseAllocLock();
scheduleExtThread(tso);
return WAIT_EXT_THREAD(tso, ret);
return scheduleWaitThread(tso,ret);
}
SchedulerStatus
......@@ -466,8 +457,7 @@ rts_eval_ (HaskellObj p, unsigned int stack_size, /*out*/HaskellObj *ret)
tso = createGenThread(stack_size, p);
releaseAllocLock();
scheduleExtThread(tso);
return WAIT_EXT_THREAD(tso, ret);
return scheduleWaitThread(tso,ret);
}
/*
......@@ -481,8 +471,7 @@ rts_evalIO (HaskellObj p, /*out*/HaskellObj *ret)
tso = createStrictIOThread(RtsFlags.GcFlags.initialStkSize, p);
releaseAllocLock();
scheduleExtThread(tso);
return WAIT_EXT_THREAD(tso, ret);
return scheduleWaitThread(tso,ret);
}
/*
......@@ -497,7 +486,7 @@ rts_mainEvalIO(HaskellObj p, /*out*/HaskellObj *ret)
tso = createStrictIOThread(RtsFlags.GcFlags.initialStkSize, p);
releaseAllocLock();
scheduleThread(tso);
return WAIT_MAIN_THREAD(tso, ret);
return waitThread(tso, ret);
}
/*
......@@ -516,8 +505,7 @@ rts_evalStableIO (HsStablePtr s, /*out*/HsStablePtr *ret)
p = (StgClosure *)deRefStablePtr(s);
tso = createStrictIOThread(RtsFlags.GcFlags.initialStkSize, p);
releaseAllocLock();
scheduleExtThread(tso);
stat = WAIT_EXT_THREAD(tso, &r);
stat = scheduleWaitThread(tso,&r);
if (stat == Success) {
ASSERT(r != NULL);
......@@ -537,8 +525,7 @@ rts_evalLazyIO (HaskellObj p, unsigned int stack_size, /*out*/HaskellObj *ret)
tso = createIOThread(stack_size, p);
releaseAllocLock();
scheduleExtThread(tso);
return WAIT_EXT_THREAD(tso, ret);
return scheduleWaitThread(tso,ret);
}
/* Convenience function for decoding the returned status. */
......
/* ---------------------------------------------------------------------------
* $Id: Schedule.c,v 1.144 2002/05/18 05:28:15 ken Exp $
* $Id: Schedule.c,v 1.145 2002/06/19 20:45:15 sof Exp $
*
* (c) The GHC Team, 1998-2000
*
......@@ -1908,6 +1908,13 @@ activateSpark (rtsSpark spark)
}
#endif
static SchedulerStatus waitThread_(/*out*/StgMainThread* m
#if defined(THREADED_RTS)
, rtsBool blockWaiting
#endif
);
/* ---------------------------------------------------------------------------
* scheduleThread()
*
......@@ -1954,12 +1961,48 @@ scheduleThread_(StgTSO *tso
void scheduleThread(StgTSO* tso)
{
return scheduleThread_(tso, rtsFalse);
scheduleThread_(tso, rtsFalse);
}
void scheduleExtThread(StgTSO* tso)
SchedulerStatus
scheduleWaitThread(StgTSO* tso, /*[out]*/HaskellObj* ret)
{
return scheduleThread_(tso, rtsTrue);
StgMainThread *m;
m = stgMallocBytes(sizeof(StgMainThread), "waitThread");
m->tso = tso;
m->ret = ret;
m->stat = NoStatus;
#if defined(RTS_SUPPORTS_THREADS)
initCondition(&m->wakeup);
#endif
/* Put the thread on the main-threads list prior to scheduling the TSO.
Failure to do so introduces a race condition in the MT case (as
identified by Wolfgang Thaller), whereby the new task/OS thread
created by scheduleThread_() would complete prior to the thread
that spawned it managed to put 'itself' on the main-threads list.
The upshot of it all being that the worker thread wouldn't get to
signal the completion of the its work item for the main thread to
see (==> it got stuck waiting.) -- sof 6/02.
*/
ACQUIRE_LOCK(&sched_mutex);
IF_DEBUG(scheduler, sched_belch("== scheduler: waiting for thread (%d)\n", tso->id));
m->link = main_threads;
main_threads = m;
/* Inefficient (scheduleThread_() acquires it again right away),
* but obviously correct.
*/
RELEASE_LOCK(&sched_mutex);
scheduleThread_(tso, rtsTrue);
#if defined(THREADED_RTS)
return waitThread_(m, rtsTrue);
#else
return waitThread_(m);
#endif
}
/* ---------------------------------------------------------------------------
......@@ -2143,40 +2186,41 @@ finishAllThreads ( void )
SchedulerStatus
waitThread(StgTSO *tso, /*out*/StgClosure **ret)
{
StgMainThread *m;
m = stgMallocBytes(sizeof(StgMainThread), "waitThread");
m->tso = tso;
m->ret = ret;
m->stat = NoStatus;
#if defined(RTS_SUPPORTS_THREADS)
initCondition(&m->wakeup);
#endif
/* see scheduleWaitThread() comment */
ACQUIRE_LOCK(&sched_mutex);
IF_DEBUG(scheduler, sched_belch("== scheduler: waiting for thread (%d)\n", tso->id));
m->link = main_threads;
main_threads = m;
RELEASE_LOCK(&sched_mutex);
IF_DEBUG(scheduler, sched_belch("== scheduler: waiting for thread (%d)\n", tso->id));
#if defined(THREADED_RTS)
return waitThread_(tso,ret, rtsFalse);
return waitThread_(m, rtsFalse);
#else
return waitThread_(tso,ret);
return waitThread_(m);
#endif
}
static
SchedulerStatus
waitThread_(StgTSO *tso,
/*out*/StgClosure **ret
waitThread_(StgMainThread* m
#if defined(THREADED_RTS)
, rtsBool blockWaiting
#endif
)
{
StgMainThread *m;
SchedulerStatus stat;
ACQUIRE_LOCK(&sched_mutex);
IF_DEBUG(scheduler, sched_belch("== scheduler: waiting for thread (%d)\n", tso->id));
m = stgMallocBytes(sizeof(StgMainThread), "waitThread");
m->tso = tso;
m->ret = ret;
m->stat = NoStatus;
#if defined(RTS_SUPPORTS_THREADS)
initCondition(&m->wakeup);
#endif
m->link = main_threads;
main_threads = m;
IF_DEBUG(scheduler, sched_belch("== scheduler: new main thread (%d)\n", m->tso->id));
#if defined(RTS_SUPPORTS_THREADS)
......@@ -2187,12 +2231,12 @@ waitThread_(StgTSO *tso,
* gets to enter the RTS directly without going via another
* task/thread.
*/
RELEASE_LOCK(&sched_mutex);
schedule();
ASSERT(m->stat != NoStatus);
} else
# endif
{
ACQUIRE_LOCK(&sched_mutex);
do {
waitCondition(&m->wakeup, &sched_mutex);
} while (m->stat == NoStatus);
......
/* -----------------------------------------------------------------------------
* $Id: Schedule.h,v 1.33 2002/04/13 05:33:03 sof Exp $
* $Id: Schedule.h,v 1.34 2002/06/19 20:45:15 sof Exp $
*
* (c) The GHC Team 1998-1999
*
......@@ -138,14 +138,6 @@ extern nat rts_n_waiting_tasks;
StgInt forkProcess(StgTSO *tso);
/* Sigh, RTS-internal versions of waitThread(), scheduleThread(), and
rts_evalIO() for the use by main() only. ToDo: better. */
extern SchedulerStatus waitThread_(StgTSO *tso,
/*out*/StgClosure **ret
#if defined(THREADED_RTS)
, rtsBool blockWaiting
#endif
);
extern SchedulerStatus rts_mainEvalIO(HaskellObj p, /*out*/HaskellObj *ret);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment