#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 (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() */
* 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.
debugTrace(DEBUG_sched, "--++ thread %lu (%s) finished",
(unsigned long)t->id, whatNext_strs[t->what_next]);
+ /* Inform the Hpc that a thread has finished */
+ hs_hpc_event("Thread Finished",t);
+
#if defined(GRAN)
endThread(t, CurrentProc); // clean-up the thread
#elif defined(PARALLEL_HASKELL)
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.
// 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;
boundTaskExiting(task);
stopTaskManager();
}
+#else
+ freeCapability(&MainCapability);
+#endif
+}
+
+void
+freeScheduler( void )
+{
+ freeTaskManager();
+ if (n_capabilities != 1) {
+ stgFree(capabilities);
+ }
+#if defined(THREADED_RTS)
closeMutex(&sched_mutex);
#endif
}
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
}
projects / ghc-hetmet.git / blobdiff