/* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.60 2000/03/31 03:09:36 hwloidl Exp $
+ * $Id: Schedule.c,v 1.69 2000/04/26 09:44:28 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
#include "Printer.h"
#include "Main.h"
#include "Signals.h"
-#include "Profiling.h"
#include "Sanity.h"
#include "Stats.h"
#include "Itimer.h"
main_threads = NULL;
}
#else /* ! SMP */
- /*
- In GUM all non-main PEs come in here with no work;
- we ignore multiple main threads for now
-
if (blocked_queue_hd == END_TSO_QUEUE
- && run_queue_hd == END_TSO_QUEUE) {
- StgMainThread *m = main_threads;
- m->ret = NULL;
- m->stat = Deadlock;
- main_threads = m->link;
- return;
+ && run_queue_hd == END_TSO_QUEUE) {
+ StgMainThread *m = main_threads;
+ m->ret = NULL;
+ m->stat = Deadlock;
+ main_threads = m->link;
+ return;
}
- */
#endif
#ifdef SMP
/* grab a thread from the run queue
*/
+ ASSERT(run_queue_hd != END_TSO_QUEUE);
t = POP_RUN_QUEUE();
IF_DEBUG(sanity,checkTSO(t));
RELEASE_LOCK(&sched_mutex);
-#if defined(GRAN) || defined(PAR)
- IF_DEBUG(scheduler, belch("-->> Running TSO %ld (%p) %s ...",
+ IF_DEBUG(scheduler, sched_belch("-->> Running TSO %ld (%p) %s ...",
t->id, t, whatNext_strs[t->what_next]));
-#else
- IF_DEBUG(scheduler,sched_belch("running thread %d", t->id));
-#endif
/* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/* Run the current thread
* maybe set context_switch and wait till they all pile in,
* then have them wait on a GC condition variable.
*/
-#if defined(GRAN) || defined(PAR)
- IF_DEBUG(scheduler,belch("--<< TSO %ld (%p; %s) stopped: HeapOverflow",
+ IF_DEBUG(scheduler,belch("--<< thread %ld (%p; %s) stopped: HeapOverflow",
t->id, t, whatNext_strs[t->what_next]));
-#endif
threadPaused(t);
#if defined(GRAN)
ASSERT(!is_on_queue(t,CurrentProc));
break;
case StackOverflow:
-#if defined(GRAN) || defined(PAR)
- IF_DEBUG(scheduler,belch("--<< TSO %ld (%p; %s) stopped, StackOverflow",
+ IF_DEBUG(scheduler,belch("--<< thread %ld (%p; %s) stopped, StackOverflow",
t->id, t, whatNext_strs[t->what_next]));
-#endif
/* just adjust the stack for this thread, then pop it back
* on the run queue.
*/
* up the GC thread. getThread will block during a GC until the
* GC is finished.
*/
-#if defined(GRAN) || defined(PAR)
IF_DEBUG(scheduler,
if (t->what_next == ThreadEnterHugs) {
/* ToDo: or maybe a timer expired when we were in Hugs?
* or maybe someone hit ctrl-C
*/
- belch("--<< TSO %ld (%p; %s) stopped to switch to Hugs",
+ belch("--<< thread %ld (%p; %s) stopped to switch to Hugs",
t->id, t, whatNext_strs[t->what_next]);
} else {
- belch("--<< TSO %ld (%p; %s) stopped, yielding",
+ belch("--<< thread %ld (%p; %s) stopped, yielding",
t->id, t, whatNext_strs[t->what_next]);
}
);
-#else
- IF_DEBUG(scheduler,
- if (t->what_next == ThreadEnterHugs) {
- /* ToDo: or maybe a timer expired when we were in Hugs?
- * or maybe someone hit ctrl-C
- */
- belch("thread %ld stopped to switch to Hugs", t->id);
- } else {
- belch("thread %ld stopped, yielding", t->id);
- }
- );
-#endif
+
threadPaused(t);
+
IF_DEBUG(sanity,
//belch("&& Doing sanity check on yielding TSO %ld.", t->id);
checkTSO(t));
case ThreadBlocked:
#if defined(GRAN)
IF_DEBUG(scheduler,
- belch("--<< TSO %ld (%p; %s) stopped, blocking on node %p [PE %d] with BQ: ",
+ belch("--<< thread %ld (%p; %s) stopped, blocking on node %p [PE %d] with BQ: ",
t->id, t, whatNext_strs[t->what_next], t->block_info.closure, (t->block_info.closure==(StgClosure*)NULL ? 99 : where_is(t->block_info.closure)));
if (t->block_info.closure!=(StgClosure*)NULL) print_bq(t->block_info.closure));
blockThread(t);
IF_DEBUG(scheduler,
- belch("--<< TSO %ld (%p; %s) stopped, blocking on node %p with BQ: ",
+ belch("--<< thread %ld (%p; %s) stopped, blocking on node %p with BQ: ",
t->id, t, whatNext_strs[t->what_next], t->block_info.closure);
if (t->block_info.closure!=(StgClosure*)NULL) print_bq(t->block_info.closure));
* case it'll be on the relevant queue already.
*/
IF_DEBUG(scheduler,
- fprintf(stderr, "--<< TSO %d (%p) stopped ", t->id, t);
+ fprintf(stderr, "--<< thread %d (%p) stopped: ", t->id, t);
printThreadBlockage(t);
fprintf(stderr, "\n"));
* more main threads, we probably need to stop all the tasks until
* we get a new one.
*/
- IF_DEBUG(scheduler,belch("--++ TSO %d (%p) finished", t->id, t));
- t->what_next = ThreadComplete;
+ /* We also end up here if the thread kills itself with an
+ * uncaught exception, see Exception.hc.
+ */
+ IF_DEBUG(scheduler,belch("--++ thread %d (%p) finished", t->id, t));
#if defined(GRAN)
endThread(t, CurrentProc); // clean-up the thread
#elif defined(PAR)
break;
default:
- barf("doneThread: invalid thread return code");
+ barf("schedule: invalid thread return code %d", (int)ret);
}
#ifdef SMP
#ifdef SMP
IF_DEBUG(scheduler,sched_belch("doing GC"));
#endif
- GarbageCollect(GetRoots);
+ GarbageCollect(GetRoots,rtsFalse);
ready_to_gc = rtsFalse;
#ifdef SMP
pthread_cond_broadcast(&gc_pending_cond);
tso = (StgTSO *)allocate(size);
TICK_ALLOC_TSO(size-TSO_STRUCT_SIZEW, 0);
- SET_HDR(tso, &TSO_info, CCS_MAIN);
+ SET_HDR(tso, &TSO_info, CCS_SYSTEM);
#if defined(GRAN)
SET_GRAN_HDR(tso, ThisPE);
#endif
/* put a stop frame on the stack */
tso->sp -= sizeofW(StgStopFrame);
- SET_HDR((StgClosure*)tso->sp,(StgInfoTable *)&stg_stop_thread_info,CCS_MAIN);
+ SET_HDR((StgClosure*)tso->sp,(StgInfoTable *)&stg_stop_thread_info,CCS_SYSTEM);
tso->su = (StgUpdateFrame*)tso->sp;
- IF_DEBUG(scheduler,belch("---- Initialised TSO %ld (%p), stack size = %lx words",
- tso->id, tso, tso->stack_size));
-
// ToDo: check this
#if defined(GRAN)
tso->link = END_TSO_QUEUE;
PUSH_ON_RUN_QUEUE(tso);
THREAD_RUNNABLE();
+#if 0
IF_DEBUG(scheduler,printTSO(tso));
+#endif
RELEASE_LOCK(&sched_mutex);
}
context_switch = 0;
interrupted = 0;
- enteredCAFs = END_CAF_LIST;
+#ifdef INTERPRETER
+ ecafList = END_ECAF_LIST;
+ clearECafTable();
+#endif
/* Install the SIGHUP handler */
#ifdef SMP
* will be in the main_thread struct.
* -------------------------------------------------------------------------- */
+int
+howManyThreadsAvail ( void )
+{
+ int i = 0;
+ StgTSO* q;
+ for (q = run_queue_hd; q != END_TSO_QUEUE; q = q->link)
+ i++;
+ for (q = blocked_queue_hd; q != END_TSO_QUEUE; q = q->link)
+ i++;
+ return i;
+}
+
+void
+finishAllThreads ( void )
+{
+ do {
+ while (run_queue_hd != END_TSO_QUEUE) {
+ waitThread ( run_queue_hd, NULL );
+ }
+ while (blocked_queue_hd != END_TSO_QUEUE) {
+ waitThread ( blocked_queue_hd, NULL );
+ }
+ } while
+ (blocked_queue_hd != END_TSO_QUEUE ||
+ run_queue_hd != END_TSO_QUEUE);
+}
+
SchedulerStatus
waitThread(StgTSO *tso, /*out*/StgClosure **ret)
{
void
performGC(void)
{
- GarbageCollect(GetRoots);
+ GarbageCollect(GetRoots,rtsFalse);
+}
+
+void
+performMajorGC(void)
+{
+ GarbageCollect(GetRoots,rtsTrue);
}
static void
{
extra_roots = get_roots;
- GarbageCollect(AllRoots);
+ GarbageCollect(AllRoots,rtsFalse);
}
/* -----------------------------------------------------------------------------
fprintf(stderr,"blocked on write to fd %d", tso->block_info.fd);
break;
case BlockedOnDelay:
-#if defined(HAVE_SETITIMER)
+#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",
projects / ghc-hetmet.git / blobdiff