#include "SchedAPI.h"
#include "RtsUtils.h"
#include "RtsFlags.h"
-#include "BlockAlloc.h"
#include "OSThreads.h"
#include "Storage.h"
#include "StgRun.h"
#include "Trace.h"
#include "RaiseAsync.h"
#include "Threads.h"
+#include "ThrIOManager.h"
#ifdef HAVE_SYS_TYPES_H
#include <sys/types.h>
StgTSO *t );
static rtsBool scheduleDoHeapProfile(rtsBool ready_to_gc);
static Capability *scheduleDoGC(Capability *cap, Task *task,
- rtsBool force_major,
- void (*get_roots)(evac_fn));
+ rtsBool force_major);
static rtsBool checkBlackHoles(Capability *cap);
-static void AllRoots(evac_fn evac);
static StgTSO *threadStackOverflow(Capability *cap, StgTSO *tso);
discardSparksCap(cap);
#endif
/* scheduleDoGC() deletes all the threads */
- cap = scheduleDoGC(cap,task,rtsFalse,GetRoots);
+ cap = scheduleDoGC(cap,task,rtsFalse);
break;
case SCHED_SHUTTING_DOWN:
debugTrace(DEBUG_sched, "SCHED_SHUTTING_DOWN");
if (bound) {
if (bound == task) {
debugTrace(DEBUG_sched,
- "### Running thread %d in bound thread", t->id);
+ "### Running thread %lu in bound thread", (unsigned long)t->id);
// yes, the Haskell thread is bound to the current native thread
} else {
debugTrace(DEBUG_sched,
- "### thread %d bound to another OS thread", t->id);
+ "### thread %lu bound to another OS thread", (unsigned long)t->id);
// no, bound to a different Haskell thread: pass to that thread
pushOnRunQueue(cap,t);
continue;
// The thread we want to run is unbound.
if (task->tso) {
debugTrace(DEBUG_sched,
- "### this OS thread cannot run thread %d", t->id);
+ "### this OS thread cannot run thread %lu", (unsigned long)t->id);
// no, the current native thread is bound to a different
// Haskell thread, so pass it to any worker thread
pushOnRunQueue(cap,t);
// immediately and return to normaility.
if (ret == ThreadBlocked) {
debugTrace(DEBUG_sched,
- "--<< thread %d (%s) stopped: blocked",
- t->id, whatNext_strs[t->what_next]);
+ "--<< thread %lu (%s) stopped: blocked",
+ (unsigned long)t->id, whatNext_strs[t->what_next]);
continue;
}
#endif
if (scheduleDoHeapProfile(ready_to_gc)) { ready_to_gc = rtsFalse; }
if (ready_to_gc) {
- cap = scheduleDoGC(cap,task,rtsFalse,GetRoots);
+ cap = scheduleDoGC(cap,task,rtsFalse);
}
} /* end of while() */
prev->link = t;
prev = t;
} else {
- debugTrace(DEBUG_sched, "pushing thread %d to capability %d", t->id, free_caps[i]->no);
+ debugTrace(DEBUG_sched, "pushing thread %lu to capability %d", (unsigned long)t->id, free_caps[i]->no);
appendToRunQueue(free_caps[i],t);
if (t->bound) { t->bound->cap = free_caps[i]; }
t->cap = free_caps[i];
* Start any pending signal handlers
* ------------------------------------------------------------------------- */
-#if defined(RTS_USER_SIGNALS) && (!defined(THREADED_RTS) || defined(mingw32_HOST_OS))
+#if defined(RTS_USER_SIGNALS) && !defined(THREADED_RTS)
static void
scheduleStartSignalHandlers(Capability *cap)
{
// they are unreachable and will therefore be sent an
// exception. Any threads thus released will be immediately
// runnable.
- cap = scheduleDoGC (cap, task, rtsTrue/*force major GC*/, GetRoots);
+ cap = scheduleDoGC (cap, task, rtsTrue/*force major GC*/);
recent_activity = ACTIVITY_DONE_GC;
if ( !emptyRunQueue(cap) ) return;
-#if defined(RTS_USER_SIGNALS) && (!defined(THREADED_RTS) || defined(mingw32_HOST_OS))
+#if defined(RTS_USER_SIGNALS) && !defined(THREADED_RTS)
/* If we have user-installed signal handlers, then wait
* for signals to arrive rather then bombing out with a
* deadlock.
#ifdef DEBUG
if (traceClass(DEBUG_sched)) {
- debugTraceBegin("--<< thread %d (%s) stopped: ",
- t->id, whatNext_strs[t->what_next]);
+ debugTraceBegin("--<< thread %lu (%s) stopped: ",
+ (unsigned long)t->id, whatNext_strs[t->what_next]);
printThreadBlockage(t);
debugTraceEnd();
}
* We also end up here if the thread kills itself with an
* uncaught exception, see Exception.cmm.
*/
- debugTrace(DEBUG_sched, "--++ thread %d (%s) finished",
- t->id, whatNext_strs[t->what_next]);
+ debugTrace(DEBUG_sched, "--++ thread %lu (%s) finished",
+ (unsigned long)t->id, whatNext_strs[t->what_next]);
#if defined(GRAN)
endThread(t, CurrentProc); // clean-up the thread
scheduleCheckBlackHoles(&MainCapability);
debugTrace(DEBUG_sched, "garbage collecting before heap census");
- GarbageCollect(GetRoots, rtsTrue);
+ GarbageCollect(rtsTrue);
debugTrace(DEBUG_sched, "performing heap census");
heapCensus();
* -------------------------------------------------------------------------- */
static Capability *
-scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS,
- rtsBool force_major, void (*get_roots)(evac_fn))
+scheduleDoGC (Capability *cap, Task *task USED_IF_THREADS, rtsBool force_major)
{
StgTSO *t;
#ifdef THREADED_RTS
#if defined(THREADED_RTS)
debugTrace(DEBUG_sched, "doing GC");
#endif
- GarbageCollect(get_roots, force_major);
+ GarbageCollect(force_major);
#if defined(THREADED_RTS)
// release our stash of capabilities.
tso = cap->r.rCurrentTSO;
debugTrace(DEBUG_sched,
- "thread %d did a safe foreign call",
- cap->r.rCurrentTSO->id);
+ "thread %lu did a safe foreign call",
+ (unsigned long)cap->r.rCurrentTSO->id);
// XXX this might not be necessary --SDM
tso->what_next = ThreadRunGHC;
/* Preparing to leave the RTS, so ensure there's a native thread/task
waiting to take over.
*/
- debugTrace(DEBUG_sched, "thread %d: leaving RTS", tso->id);
+ debugTrace(DEBUG_sched, "thread %lu: leaving RTS", (unsigned long)tso->id);
#endif
errno = saved_errno;
tso = task->suspended_tso;
task->suspended_tso = NULL;
tso->link = END_TSO_QUEUE;
- debugTrace(DEBUG_sched, "thread %d: re-entering RTS", tso->id);
+ debugTrace(DEBUG_sched, "thread %lu: re-entering RTS", (unsigned long)tso->id);
if (tso->why_blocked == BlockedOnCCall) {
awakenBlockedExceptionQueue(cap,tso);
appendToRunQueue(cap,tso);
- debugTrace(DEBUG_sched, "new bound thread (%d)", tso->id);
+ debugTrace(DEBUG_sched, "new bound thread (%lu)", (unsigned long)tso->id);
#if defined(GRAN)
/* GranSim specific init */
ASSERT(task->stat != NoStatus);
ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
- debugTrace(DEBUG_sched, "bound thread (%d) finished", task->tso->id);
+ debugTrace(DEBUG_sched, "bound thread (%lu) finished", (unsigned long)task->tso->id);
return cap;
}
context_switch = 0;
sched_state = SCHED_RUNNING;
- RtsFlags.ConcFlags.ctxtSwitchTicks =
- RtsFlags.ConcFlags.ctxtSwitchTime / TICK_MILLISECS;
-
#if defined(THREADED_RTS)
/* Initialise the mutex and condition variables used by
* the scheduler. */
// If we haven't killed all the threads yet, do it now.
if (sched_state < SCHED_SHUTTING_DOWN) {
sched_state = SCHED_INTERRUPTING;
- scheduleDoGC(NULL,task,rtsFalse,GetRoots);
+ scheduleDoGC(NULL,task,rtsFalse);
}
sched_state = SCHED_SHUTTING_DOWN;
#endif
}
+void
+freeScheduler( void )
+{
+ freeTaskManager();
+#if defined(THREADED_RTS)
+ closeMutex(&sched_mutex);
+#endif
+}
+
/* ---------------------------------------------------------------------------
Where are the roots that we know about?
for (task = cap->suspended_ccalling_tasks; task != NULL;
task=task->next) {
debugTrace(DEBUG_sched,
- "evac'ing suspended TSO %d", task->suspended_tso->id);
+ "evac'ing suspended TSO %lu", (unsigned long)task->suspended_tso->id);
evac((StgClosure **)(void *)&task->suspended_tso);
}
This is the interface to the garbage collector from Haskell land.
We provide this so that external C code can allocate and garbage
collect when called from Haskell via _ccall_GC.
-
- It might be useful to provide an interface whereby the programmer
- can specify more roots (ToDo).
-
- This needs to be protected by the GC condition variable above. KH.
-------------------------------------------------------------------------- */
-static void (*extra_roots)(evac_fn);
-
static void
-performGC_(rtsBool force_major, void (*get_roots)(evac_fn))
+performGC_(rtsBool force_major)
{
Task *task;
// We must grab a new Task here, because the existing Task may be
ACQUIRE_LOCK(&sched_mutex);
task = newBoundTask();
RELEASE_LOCK(&sched_mutex);
- scheduleDoGC(NULL,task,force_major, get_roots);
+ scheduleDoGC(NULL,task,force_major);
boundTaskExiting(task);
}
void
performGC(void)
{
- performGC_(rtsFalse, GetRoots);
+ performGC_(rtsFalse);
}
void
performMajorGC(void)
{
- performGC_(rtsTrue, GetRoots);
-}
-
-static void
-AllRoots(evac_fn evac)
-{
- GetRoots(evac); // the scheduler's roots
- extra_roots(evac); // the user's roots
-}
-
-void
-performGCWithRoots(void (*get_roots)(evac_fn))
-{
- extra_roots = get_roots;
- performGC_(rtsFalse, AllRoots);
+ performGC_(rtsTrue);
}
/* -----------------------------------------------------------------------------
wakeUpRts(void)
{
#if defined(THREADED_RTS)
-#if !defined(mingw32_HOST_OS)
// This forces the IO Manager thread to wakeup, which will
// in turn ensure that some OS thread wakes up and runs the
// scheduler loop, which will cause a GC and deadlock check.
ioManagerWakeup();
-#else
- // On Windows this might be safe enough, because we aren't
- // in a signal handler. Later we should use the IO Manager,
- // though.
- prodOneCapability();
-#endif
#endif
}
This should either be a CATCH_RETRY_FRAME (if the retry# is within an orElse#)
or should be a ATOMICALLY_FRAME (if the retry# reaches the top level).
- We skip CATCH_STM_FRAMEs because retries are not considered to be exceptions,
- despite the similar implementation.
+ We skip CATCH_STM_FRAMEs (aborting and rolling back the nested tx that they
+ create) because retries are not considered to be exceptions, despite the
+ similar implementation.
We should not expect to see CATCH_FRAME or STOP_FRAME because those should
not be created within memory transactions.
case ATOMICALLY_FRAME:
debugTrace(DEBUG_stm,
- "found ATOMICALLY_FRAME at %p during retrry", p);
+ "found ATOMICALLY_FRAME at %p during retry", p);
tso->sp = p;
return ATOMICALLY_FRAME;
tso->sp = p;
return CATCH_RETRY_FRAME;
- case CATCH_STM_FRAME:
+ case CATCH_STM_FRAME: {
+ debugTrace(DEBUG_stm,
+ "found CATCH_STM_FRAME at %p during retry", p);
+ StgTRecHeader *trec = tso -> trec;
+ StgTRecHeader *outer = stmGetEnclosingTRec(trec);
+ debugTrace(DEBUG_stm, "trec=%p outer=%p", trec, outer);
+ stmAbortTransaction(tso -> cap, trec);
+ stmFreeAbortedTRec(tso -> cap, trec);
+ tso -> trec = outer;
+ p = next;
+ continue;
+ }
+
+
default:
ASSERT(info->i.type != CATCH_FRAME);
ASSERT(info->i.type != STOP_FRAME);
next = tso->global_link;
tso->global_link = all_threads;
all_threads = tso;
- debugTrace(DEBUG_sched, "resurrecting thread %d", tso->id);
+ debugTrace(DEBUG_sched, "resurrecting thread %lu", (unsigned long)tso->id);
// Wake up the thread on the Capability it was last on
cap = tso->cap;