summaryrefslogtreecommitdiff
path: root/rts
diff options
context:
space:
mode:
Diffstat (limited to 'rts')
-rw-r--r--rts/Capability.c2
-rw-r--r--rts/Capability.h5
-rw-r--r--rts/HeapStackCheck.cmm5
-rw-r--r--rts/Linker.c4
-rw-r--r--rts/Prelude.h2
-rw-r--r--rts/PrimOps.cmm22
-rw-r--r--rts/Profiling.c6
-rw-r--r--rts/RetainerProfile.c6
-rw-r--r--rts/RtsFlags.c3
-rw-r--r--rts/RtsStartup.c14
-rw-r--r--rts/Schedule.c13
-rw-r--r--rts/Stable.c1
-rw-r--r--rts/Stats.c45
-rw-r--r--rts/Stats.h3
-rw-r--r--rts/Task.c16
-rw-r--r--rts/Task.h5
-rw-r--r--rts/eventlog/EventLog.c5
-rw-r--r--rts/package.conf.in2
-rw-r--r--rts/posix/Select.c179
-rw-r--r--rts/sm/Compact.c55
-rw-r--r--rts/sm/GC.c8
-rw-r--r--rts/sm/GCThread.h3
-rw-r--r--rts/sm/MarkWeak.c41
-rw-r--r--rts/sm/MarkWeak.h1
-rw-r--r--rts/sm/Scav.c59
-rw-r--r--rts/sm/Storage.c10
-rw-r--r--rts/win32/libHSbase.def3
27 files changed, 316 insertions, 202 deletions
diff --git a/rts/Capability.c b/rts/Capability.c
index 16b71b7045..805a35be9f 100644
--- a/rts/Capability.c
+++ b/rts/Capability.c
@@ -273,6 +273,8 @@ initCapability( Capability *cap, nat i )
cap->mut_lists[g] = NULL;
}
+ cap->weak_ptr_list_hd = NULL;
+ cap->weak_ptr_list_tl = NULL;
cap->free_tvar_watch_queues = END_STM_WATCH_QUEUE;
cap->free_invariant_check_queues = END_INVARIANT_CHECK_QUEUE;
cap->free_trec_chunks = END_STM_CHUNK_LIST;
diff --git a/rts/Capability.h b/rts/Capability.h
index f342d92244..d36d50293a 100644
--- a/rts/Capability.h
+++ b/rts/Capability.h
@@ -79,6 +79,11 @@ struct Capability_ {
// full pinned object blocks allocated since the last GC
bdescr *pinned_object_blocks;
+ // per-capability weak pointer list associated with nursery (older
+ // lists stored in generation object)
+ StgWeak *weak_ptr_list_hd;
+ StgWeak *weak_ptr_list_tl;
+
// Context switch flag. When non-zero, this means: stop running
// Haskell code, and switch threads.
int context_switch;
diff --git a/rts/HeapStackCheck.cmm b/rts/HeapStackCheck.cmm
index d826529aef..12bcfb26df 100644
--- a/rts/HeapStackCheck.cmm
+++ b/rts/HeapStackCheck.cmm
@@ -196,7 +196,8 @@ stg_gc_prim_n (W_ arg, W_ fun)
jump fun(arg);
}
-stg_gc_prim_p_ll_ret
+INFO_TABLE_RET(stg_gc_prim_p_ll, RET_SMALL, W_ info, P_ arg, W_ fun)
+ /* explicit stack */
{
W_ fun;
P_ arg;
@@ -216,7 +217,7 @@ stg_gc_prim_p_ll
Sp_adj(-3);
Sp(2) = fun;
Sp(1) = arg;
- Sp(0) = stg_gc_prim_p_ll_ret;
+ Sp(0) = stg_gc_prim_p_ll_info;
jump stg_gc_noregs [];
}
diff --git a/rts/Linker.c b/rts/Linker.c
index 1b0d48facf..ad96d74b6f 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -1186,7 +1186,6 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(stg_newBCOzh) \
SymI_HasProto(stg_newByteArrayzh) \
SymI_HasProto(stg_casIntArrayzh) \
- SymI_HasProto(stg_fetchAddIntArrayzh) \
SymI_HasProto(stg_newMVarzh) \
SymI_HasProto(stg_newMutVarzh) \
SymI_HasProto(stg_newTVarzh) \
@@ -1900,6 +1899,7 @@ addDLL( pathchar *dll_name )
// success -- try to dlopen the first named file
IF_DEBUG(linker, debugBelch("match%s\n",""));
line[match[2].rm_eo] = '\0';
+ stgFree((void*)errmsg); // Free old message before creating new one
errmsg = internal_dlopen(line+match[2].rm_so);
break;
}
@@ -2718,6 +2718,7 @@ loadArchive( pathchar *path )
if (0 == loadOc(oc)) {
stgFree(fileName);
+ fclose(f);
return 0;
}
}
@@ -4143,6 +4144,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
if (0==strcmp(".text",(char*)secname) ||
0==strcmp(".text.startup",(char*)secname) ||
+ 0==strcmp(".text.unlikely", (char*)secname) ||
0==strcmp(".rdata",(char*)secname)||
0==strcmp(".eh_frame", (char*)secname)||
0==strcmp(".rodata",(char*)secname))
diff --git a/rts/Prelude.h b/rts/Prelude.h
index 89e80a0a3d..0c54148ba2 100644
--- a/rts/Prelude.h
+++ b/rts/Prelude.h
@@ -42,6 +42,7 @@ PRELUDE_CLOSURE(base_GHCziIOziException_blockedIndefinitelyOnMVar_closure);
PRELUDE_CLOSURE(base_GHCziIOziException_blockedIndefinitelyOnSTM_closure);
PRELUDE_CLOSURE(base_ControlziExceptionziBase_nonTermination_closure);
PRELUDE_CLOSURE(base_ControlziExceptionziBase_nestedAtomically_closure);
+PRELUDE_CLOSURE(base_GHCziEventziThread_blockedOnBadFD_closure);
PRELUDE_CLOSURE(base_GHCziConcziSync_runSparks_closure);
PRELUDE_CLOSURE(base_GHCziConcziIO_ensureIOManagerIsRunning_closure);
@@ -104,6 +105,7 @@ PRELUDE_INFO(base_GHCziStable_StablePtr_con_info);
#define blockedIndefinitelyOnSTM_closure DLL_IMPORT_DATA_REF(base_GHCziIOziException_blockedIndefinitelyOnSTM_closure)
#define nonTermination_closure DLL_IMPORT_DATA_REF(base_ControlziExceptionziBase_nonTermination_closure)
#define nestedAtomically_closure DLL_IMPORT_DATA_REF(base_ControlziExceptionziBase_nestedAtomically_closure)
+#define blockedOnBadFD_closure DLL_IMPORT_DATA_REF(base_GHCziEventziThread_blockedOnBadFD_closure)
#define Czh_static_info DLL_IMPORT_DATA_REF(ghczmprim_GHCziTypes_Czh_static_info)
#define Fzh_static_info DLL_IMPORT_DATA_REF(ghczmprim_GHCziTypes_Fzh_static_info)
diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 1dc232d9a7..5f04a6d732 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -151,18 +151,6 @@ stg_casIntArrayzh( gcptr arr, W_ ind, W_ old, W_ new )
}
-stg_fetchAddIntArrayzh( gcptr arr, W_ ind, W_ incr )
-/* MutableByteArray# s -> Int# -> Int# -> State# s -> (# State# s, Int# #) */
-{
- W_ p, h;
-
- p = arr + SIZEOF_StgArrWords + WDS(ind);
- (h) = ccall atomic_inc(p, incr);
-
- return(h);
-}
-
-
stg_newArrayzh ( W_ n /* words */, gcptr init )
{
W_ words, size, p;
@@ -577,10 +565,11 @@ stg_mkWeakzh ( gcptr key,
StgWeak_finalizer(w) = finalizer;
StgWeak_cfinalizers(w) = stg_NO_FINALIZER_closure;
- ACQUIRE_LOCK(sm_mutex);
- StgWeak_link(w) = generation_weak_ptr_list(W_[g0]);
- generation_weak_ptr_list(W_[g0]) = w;
- RELEASE_LOCK(sm_mutex);
+ StgWeak_link(w) = Capability_weak_ptr_list_hd(MyCapability());
+ Capability_weak_ptr_list_hd(MyCapability()) = w;
+ if (Capability_weak_ptr_list_tl(MyCapability()) == NULL) {
+ Capability_weak_ptr_list_tl(MyCapability()) = w;
+ }
IF_DEBUG(weak, ccall debugBelch(stg_weak_msg,w));
@@ -1785,6 +1774,7 @@ stg_tryReadMVarzh ( P_ mvar, /* :: MVar a */ )
LOCK_CLOSURE(mvar, info);
if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
+ unlockClosure(mvar, info);
return (0, stg_NO_FINALIZER_closure);
}
diff --git a/rts/Profiling.c b/rts/Profiling.c
index 50c9c391e7..53f64a7280 100644
--- a/rts/Profiling.c
+++ b/rts/Profiling.c
@@ -619,10 +619,8 @@ actualPush_ (CostCentreStack *ccs, CostCentre *cc, CostCentreStack *new_ccs)
ccsSetSelected(new_ccs);
/* update the memoization table for the parent stack */
- if (ccs != EMPTY_STACK) {
- ccs->indexTable = addToIndexTable(ccs->indexTable, new_ccs, cc,
- 0/*not a back edge*/);
- }
+ ccs->indexTable = addToIndexTable(ccs->indexTable, new_ccs, cc,
+ 0/*not a back edge*/);
/* return a pointer to the new stack */
return new_ccs;
diff --git a/rts/RetainerProfile.c b/rts/RetainerProfile.c
index bdfc831b94..bfc96247aa 100644
--- a/rts/RetainerProfile.c
+++ b/rts/RetainerProfile.c
@@ -1781,6 +1781,12 @@ computeRetainerSet( void )
//
// The following code assumes that WEAK objects are considered to be roots
// for retainer profilng.
+ for (n = 0; n < n_capabilities; n++) {
+ // NB: after a GC, all nursery weak_ptr_lists have been migrated
+ // to the global lists living in the generations
+ ASSERT(capabilities[n]->weak_ptr_list_hd == NULL);
+ ASSERT(capabilities[n]->weak_ptr_list_tl == NULL);
+ }
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
for (weak = generations[g].weak_ptr_list; weak != NULL; weak = weak->link) {
// retainRoot((StgClosure *)weak);
diff --git a/rts/RtsFlags.c b/rts/RtsFlags.c
index af1b2049f6..44c05cec3b 100644
--- a/rts/RtsFlags.c
+++ b/rts/RtsFlags.c
@@ -241,7 +241,8 @@ usage_text[] = {
" -? Prints this message and exits; the program is not executed",
" --info Print information about the RTS used by this program",
"",
-" -K<size> Sets the maximum stack size (default 8M) Egs: -K32k -K512k",
+" -K<size> Sets the maximum stack size (default: 80% of the heap)",
+" Egs: -K32k -K512k -K8M",
" -ki<size> Sets the initial thread stack size (default 1k) Egs: -ki4k -ki2m",
" -kc<size> Sets the stack chunk size (default 32k)",
" -kb<size> Sets the stack chunk buffer size (default 1k)",
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index aa7306f88a..8e7e11dd26 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -214,6 +214,7 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
getStablePtr((StgPtr)ensureIOManagerIsRunning_closure);
getStablePtr((StgPtr)ioManagerCapabilitiesChanged_closure);
#ifndef mingw32_HOST_OS
+ getStablePtr((StgPtr)blockedOnBadFD_closure);
getStablePtr((StgPtr)runHandlers_closure);
#endif
@@ -304,7 +305,7 @@ hs_add_root(void (*init_root)(void) STG_UNUSED)
static void
hs_exit_(rtsBool wait_foreign)
{
- nat g;
+ nat g, i;
if (hs_init_count <= 0) {
errorBelch("warning: too many hs_exit()s");
@@ -336,6 +337,9 @@ hs_exit_(rtsBool wait_foreign)
exitScheduler(wait_foreign);
/* run C finalizers for all active weak pointers */
+ for (i = 0; i < n_capabilities; i++) {
+ runAllCFinalizers(capabilities[i]->weak_ptr_list_hd);
+ }
for (g = 0; g < RtsFlags.GcFlags.generations; g++) {
runAllCFinalizers(generations[g].weak_ptr_list);
}
@@ -355,8 +359,12 @@ hs_exit_(rtsBool wait_foreign)
resetTerminalSettings();
#endif
- // uninstall signal handlers
- resetDefaultHandlers();
+#if defined(RTS_USER_SIGNALS)
+ if (RtsFlags.MiscFlags.install_signal_handlers) {
+ // uninstall signal handlers
+ resetDefaultHandlers();
+ }
+#endif
/* stop timing the shutdown, we're about to print stats */
stat_endExit();
diff --git a/rts/Schedule.c b/rts/Schedule.c
index adf2b5cb39..7f8ced6f3e 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -1802,6 +1802,10 @@ forkProcess(HsStablePtr *entry
ACQUIRE_LOCK(&capabilities[i]->lock);
}
+#ifdef THREADED_RTS
+ ACQUIRE_LOCK(&all_tasks_mutex);
+#endif
+
stopTimer(); // See #4074
#if defined(TRACING)
@@ -1823,13 +1827,18 @@ forkProcess(HsStablePtr *entry
releaseCapability_(capabilities[i],rtsFalse);
RELEASE_LOCK(&capabilities[i]->lock);
}
+
+#ifdef THREADED_RTS
+ RELEASE_LOCK(&all_tasks_mutex);
+#endif
+
boundTaskExiting(task);
// just return the pid
return pid;
} else { // child
-
+
#if defined(THREADED_RTS)
initMutex(&sched_mutex);
initMutex(&sm_mutex);
@@ -1839,6 +1848,8 @@ forkProcess(HsStablePtr *entry
for (i=0; i < n_capabilities; i++) {
initMutex(&capabilities[i]->lock);
}
+
+ initMutex(&all_tasks_mutex);
#endif
#ifdef TRACING
diff --git a/rts/Stable.c b/rts/Stable.c
index ec74b0da13..431b7c66c1 100644
--- a/rts/Stable.c
+++ b/rts/Stable.c
@@ -246,6 +246,7 @@ STATIC_INLINE void
freeSnEntry(snEntry *sn)
{
ASSERT(sn->sn_obj == NULL);
+ removeHashTable(addrToStableHash, (W_)sn->old, NULL);
sn->addr = (P_)stable_name_free;
stable_name_free = sn;
}
diff --git a/rts/Stats.c b/rts/Stats.c
index 48c320c8f7..c3d963c845 100644
--- a/rts/Stats.c
+++ b/rts/Stats.c
@@ -173,8 +173,8 @@ initStats1 (void)
nat i;
if (RtsFlags.GcFlags.giveStats >= VERBOSE_GC_STATS) {
- statsPrintf(" Alloc Copied Live GC GC TOT TOT Page Flts\n");
- statsPrintf(" bytes bytes bytes user elap user elap\n");
+ statsPrintf(" Alloc Copied Live GC GC TOT TOT Page Flts\n");
+ statsPrintf(" bytes bytes bytes user elap user elap\n");
}
GC_coll_cpu =
(Time *)stgMallocBytes(
@@ -287,53 +287,12 @@ stat_startGC (Capability *cap, gc_thread *gct)
traceEventGcStartAtT(cap,
TimeToNS(gct->gc_start_elapsed - start_init_elapsed));
- gct->gc_start_thread_cpu = getThreadCPUTime();
-
if (RtsFlags.GcFlags.giveStats != NO_GC_STATS)
{
gct->gc_start_faults = getPageFaults();
}
}
-void
-stat_gcWorkerThreadStart (gc_thread *gct STG_UNUSED)
-{
-#if 0
- /*
- * We dont' collect per-thread GC stats any more, but this code
- * could be used to do that if we want to in the future:
- */
- if (RtsFlags.GcFlags.giveStats != NO_GC_STATS)
- {
- getProcessTimes(&gct->gc_start_cpu, &gct->gc_start_elapsed);
- gct->gc_start_thread_cpu = getThreadCPUTime();
- }
-#endif
-}
-
-void
-stat_gcWorkerThreadDone (gc_thread *gct STG_UNUSED)
-{
-#if 0
- /*
- * We dont' collect per-thread GC stats any more, but this code
- * could be used to do that if we want to in the future:
- */
- Time thread_cpu, elapsed, gc_cpu, gc_elapsed;
-
- if (RtsFlags.GcFlags.giveStats != NO_GC_STATS)
- {
- elapsed = getProcessElapsedTime();
- thread_cpu = getThreadCPUTime();
-
- gc_cpu = thread_cpu - gct->gc_start_thread_cpu;
- gc_elapsed = elapsed - gct->gc_start_elapsed;
-
- taskDoneGC(gct->cap->running_task, gc_cpu, gc_elapsed);
- }
-#endif
-}
-
/* -----------------------------------------------------------------------------
* Calculate the total allocated memory since the start of the
* program. Also emits events reporting the per-cap allocation
diff --git a/rts/Stats.h b/rts/Stats.h
index 9839e5cf2a..925920f108 100644
--- a/rts/Stats.h
+++ b/rts/Stats.h
@@ -32,9 +32,6 @@ void stat_endGC (Capability *cap, struct gc_thread_ *_gct,
W_ live, W_ copied, W_ slop, nat gen,
nat n_gc_threads, W_ par_max_copied, W_ par_tot_copied);
-void stat_gcWorkerThreadStart (struct gc_thread_ *_gct);
-void stat_gcWorkerThreadDone (struct gc_thread_ *_gct);
-
#ifdef PROFILING
void stat_startRP(void);
void stat_endRP(nat,
diff --git a/rts/Task.c b/rts/Task.c
index 12c22c4b02..842ad84a89 100644
--- a/rts/Task.c
+++ b/rts/Task.c
@@ -39,7 +39,7 @@ static Task * allocTask (void);
static Task * newTask (rtsBool);
#if defined(THREADED_RTS)
-static Mutex all_tasks_mutex;
+Mutex all_tasks_mutex;
#endif
/* -----------------------------------------------------------------------------
@@ -350,6 +350,20 @@ discardTasksExcept (Task *keep)
next = task->all_next;
if (task != keep) {
debugTrace(DEBUG_sched, "discarding task %" FMT_SizeT "", (size_t)TASK_ID(task));
+#if defined(THREADED_RTS)
+ // It is possible that some of these tasks are currently blocked
+ // (in the parent process) either on their condition variable
+ // `cond` or on their mutex `lock`. If they are we may deadlock
+ // when `freeTask` attempts to call `closeCondition` or
+ // `closeMutex` (the behaviour of these functions is documented to
+ // be undefined in the case that there are threads blocked on
+ // them). To avoid this, we re-initialize both the condition
+ // variable and the mutex before calling `freeTask` (we do
+ // precisely the same for all global locks in `forkProcess`).
+ initCondition(&task->cond);
+ initMutex(&task->lock);
+#endif
+
// Note that we do not traceTaskDelete here because
// we are not really deleting a task.
// The OS threads for all these tasks do not exist in
diff --git a/rts/Task.h b/rts/Task.h
index cf70256326..8dab0a2fcf 100644
--- a/rts/Task.h
+++ b/rts/Task.h
@@ -171,6 +171,11 @@ isBoundTask (Task *task)
//
extern Task *all_tasks;
+// The all_tasks list is protected by the all_tasks_mutex
+#if defined(THREADED_RTS)
+extern Mutex all_tasks_mutex;
+#endif
+
// Start and stop the task manager.
// Requires: sched_mutex.
//
diff --git a/rts/eventlog/EventLog.c b/rts/eventlog/EventLog.c
index 2e0e9bbddc..4fd4b44d80 100644
--- a/rts/eventlog/EventLog.c
+++ b/rts/eventlog/EventLog.c
@@ -106,6 +106,7 @@ char *EventDesc[] = {
[EVENT_TASK_CREATE] = "Task create",
[EVENT_TASK_MIGRATE] = "Task migrate",
[EVENT_TASK_DELETE] = "Task delete",
+ [EVENT_HACK_BUG_T9003] = "Empty event for bug #9003",
};
// Event type.
@@ -420,6 +421,10 @@ initEventLogging(void)
sizeof(EventCapNo);
break;
+ case EVENT_HACK_BUG_T9003:
+ eventTypes[t].size = 0;
+ break;
+
default:
continue; /* ignore deprecated events */
}
diff --git a/rts/package.conf.in b/rts/package.conf.in
index 4c8686f262..8250bc2bb6 100644
--- a/rts/package.conf.in
+++ b/rts/package.conf.in
@@ -99,6 +99,7 @@ ld-options:
, "-Wl,-u,_base_GHCziIOziException_blockedIndefinitelyOnMVar_closure"
, "-Wl,-u,_base_GHCziIOziException_blockedIndefinitelyOnSTM_closure"
, "-Wl,-u,_base_ControlziExceptionziBase_nestedAtomically_closure"
+ , "-Wl,-u,_base_GHCziEventziThread_blockedOnBadFD_closure"
, "-Wl,-u,_base_GHCziWeak_runFinalizzerBatch_closure"
, "-Wl,-u,_base_GHCziTopHandler_flushStdHandles_closure"
, "-Wl,-u,_base_GHCziTopHandler_runIO_closure"
@@ -139,6 +140,7 @@ ld-options:
, "-Wl,-u,base_GHCziIOziException_blockedIndefinitelyOnMVar_closure"
, "-Wl,-u,base_GHCziIOziException_blockedIndefinitelyOnSTM_closure"
, "-Wl,-u,base_ControlziExceptionziBase_nestedAtomically_closure"
+ , "-Wl,-u,base_GHCziEventziThread_blockedOnBadFD_closure"
, "-Wl,-u,base_GHCziWeak_runFinalizzerBatch_closure"
, "-Wl,-u,base_GHCziTopHandler_flushStdHandles_closure"
, "-Wl,-u,base_GHCziTopHandler_runIO_closure"
diff --git a/rts/posix/Select.c b/rts/posix/Select.c
index 3d92a4666a..a101f03dd5 100644
--- a/rts/posix/Select.c
+++ b/rts/posix/Select.c
@@ -14,6 +14,8 @@
#include "Signals.h"
#include "Schedule.h"
+#include "Prelude.h"
+#include "RaiseAsync.h"
#include "RtsUtils.h"
#include "Itimer.h"
#include "Capability.h"
@@ -120,6 +122,85 @@ fdOutOfRange (int fd)
stg_exit(EXIT_FAILURE);
}
+/*
+ * State of individual file descriptor after a 'select()' poll.
+ */
+enum FdState {
+ RTS_FD_IS_READY = 0,
+ RTS_FD_IS_BLOCKING,
+ RTS_FD_IS_INVALID,
+};
+
+static enum FdState fdPollReadState (int fd)
+{
+ int r;
+ fd_set rfd;
+ struct timeval now;
+
+ FD_ZERO(&rfd);
+ FD_SET(fd, &rfd);
+
+ /* only poll */
+ now.tv_sec = 0;
+ now.tv_usec = 0;
+ for (;;)
+ {
+ r = select(fd+1, &rfd, NULL, NULL, &now);
+ /* the descriptor is sane */
+ if (r != -1)
+ break;
+
+ switch (errno)
+ {
+ case EBADF: return RTS_FD_IS_INVALID;
+ case EINTR: continue;
+ default:
+ sysErrorBelch("select");
+ stg_exit(EXIT_FAILURE);
+ }
+ }
+
+ if (r == 0)
+ return RTS_FD_IS_BLOCKING;
+ else
+ return RTS_FD_IS_READY;
+}
+
+static enum FdState fdPollWriteState (int fd)
+{
+ int r;
+ fd_set wfd;
+ struct timeval now;
+
+ FD_ZERO(&wfd);
+ FD_SET(fd, &wfd);
+
+ /* only poll */
+ now.tv_sec = 0;
+ now.tv_usec = 0;
+ for (;;)
+ {
+ r = select(fd+1, NULL, &wfd, NULL, &now);
+ /* the descriptor is sane */
+ if (r != -1)
+ break;
+
+ switch (errno)
+ {
+ case EBADF: return RTS_FD_IS_INVALID;
+ case EINTR: continue;
+ default:
+ sysErrorBelch("select");
+ stg_exit(EXIT_FAILURE);
+ }
+ }
+
+ if (r == 0)
+ return RTS_FD_IS_BLOCKING;
+ else
+ return RTS_FD_IS_READY;
+}
+
/* Argument 'wait' says whether to wait for I/O to become available,
* or whether to just check and return immediately. If there are
* other threads ready to run, we normally do the non-waiting variety,
@@ -137,12 +218,10 @@ void
awaitEvent(rtsBool wait)
{
StgTSO *tso, *prev, *next;
- rtsBool ready;
fd_set rfd,wfd;
int numFound;
int maxfd = -1;
- rtsBool select_succeeded = rtsTrue;
- rtsBool unblock_all = rtsFalse;
+ rtsBool seen_bad_fd = rtsFalse;
struct timeval tv, *ptv;
LowResTime now;
@@ -225,25 +304,8 @@ awaitEvent(rtsBool wait)
while ((numFound = select(maxfd+1, &rfd, &wfd, NULL, ptv)) < 0) {
if (errno != EINTR) {
- /* Handle bad file descriptors by unblocking all the
- waiting threads. Why? Because a thread might have been
- a bit naughty and closed a file descriptor while another
- was blocked waiting. This is less-than-good programming
- practice, but having the RTS as a result fall over isn't
- acceptable, so we simply unblock all the waiting threads
- should we see a bad file descriptor & give the threads
- a chance to clean up their act.
-
- Note: assume here that threads becoming unblocked
- will try to read/write the file descriptor before trying
- to issue a threadWaitRead/threadWaitWrite again (==> an
- IOError will result for the thread that's got the bad
- file descriptor.) Hence, there's no danger of a bad
- file descriptor being repeatedly select()'ed on, so
- the RTS won't loop.
- */
if ( errno == EBADF ) {
- unblock_all = rtsTrue;
+ seen_bad_fd = rtsTrue;
break;
} else {
sysErrorBelch("select");
@@ -286,33 +348,58 @@ awaitEvent(rtsBool wait)
*/
prev = NULL;
- if (select_succeeded || unblock_all) {
- for(tso = blocked_queue_hd; tso != END_TSO_QUEUE; tso = next) {
- next = tso->_link;
+ {
+ for(tso = blocked_queue_hd; tso != END_TSO_QUEUE; tso = next) {
+ next = tso->_link;
+ int fd;
+ enum FdState fd_state = RTS_FD_IS_BLOCKING;
switch (tso->why_blocked) {
- case BlockedOnRead:
- ready = unblock_all || FD_ISSET(tso->block_info.fd, &rfd);
- break;
- case BlockedOnWrite:
- ready = unblock_all || FD_ISSET(tso->block_info.fd, &wfd);
- break;
- default:
- barf("awaitEvent");
- }
-
- if (ready) {
- IF_DEBUG(scheduler,debugBelch("Waking up blocked thread %lu\n", (unsigned long)tso->id));
- tso->why_blocked = NotBlocked;
- tso->_link = END_TSO_QUEUE;
- pushOnRunQueue(&MainCapability,tso);
- } else {
- if (prev == NULL)
- blocked_queue_hd = tso;
- else
- setTSOLink(&MainCapability, prev, tso);
- prev = tso;
- }
+ case BlockedOnRead:
+ fd = tso->block_info.fd;
+
+ if (seen_bad_fd) {
+ fd_state = fdPollReadState (fd);
+ } else if (FD_ISSET(fd, &rfd)) {
+ fd_state = RTS_FD_IS_READY;
+ }
+ break;
+ case BlockedOnWrite:
+ fd = tso->block_info.fd;
+
+ if (seen_bad_fd) {
+ fd_state = fdPollWriteState (fd);
+ } else if (FD_ISSET(fd, &wfd)) {
+ fd_state = RTS_FD_IS_READY;
+ }
+ break;
+ default:
+ barf("awaitEvent");
+ }
+
+ switch (fd_state) {
+ case RTS_FD_IS_INVALID:
+ /*
+ * Don't let RTS loop on such descriptors,
+ * pass an IOError to blocked threads (Trac #4934)
+ */
+ IF_DEBUG(scheduler,debugBelch("Killing blocked thread %lu on bad fd=%i\n", (unsigned long)tso->id, fd));
+ throwToSingleThreaded(&MainCapability, tso, (StgClosure *)blockedOnBadFD_closure);
+ break;
+ case RTS_FD_IS_READY:
+ IF_DEBUG(scheduler,debugBelch("Waking up blocked thread %lu\n", (unsigned long)tso->id));
+ tso->why_blocked = NotBlocked;
+ tso->_link = END_TSO_QUEUE;
+ pushOnRunQueue(&MainCapability,tso);
+ break;
+ case RTS_FD_IS_BLOCKING:
+ if (prev == NULL)
+ blocked_queue_hd = tso;
+ else
+ setTSOLink(&MainCapability, prev, tso);
+ prev = tso;
+ break;
+ }
}
if (prev == NULL)
diff --git a/rts/sm/Compact.c b/rts/sm/Compact.c
index 8ae72a96e0..b07a886eab 100644
--- a/rts/sm/Compact.c
+++ b/rts/sm/Compact.c
@@ -183,7 +183,7 @@ loop:
// A word-aligned memmove will be faster for small objects than libc's or gcc's.
// Remember, the two regions *might* overlap, but: to <= from.
STATIC_INLINE void
-move(StgPtr to, StgPtr from, W_ size)
+move(StgPtr to, StgPtr from, StgWord size)
{
for(; size > 0; --size) {
*to++ = *from++;
@@ -225,7 +225,7 @@ thread_static( StgClosure* p )
}
STATIC_INLINE void
-thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, W_ size )
+thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, StgWord size )
{
W_ i, b;
StgWord bitmap;
@@ -248,11 +248,25 @@ thread_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, W_ size )
}
STATIC_INLINE StgPtr
+thread_small_bitmap (StgPtr p, StgWord size, StgWord bitmap)
+{
+ while (size > 0) {
+ if ((bitmap & 1) == 0) {
+ thread((StgClosure **)p);
+ }
+ p++;
+ bitmap = bitmap >> 1;
+ size--;
+ }
+ return p;
+}
+
+STATIC_INLINE StgPtr
thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
{
StgPtr p;
StgWord bitmap;
- W_ size;
+ StgWord size;
p = (StgPtr)args;
switch (fun_info->f.fun_type) {
@@ -269,14 +283,7 @@ thread_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
small_bitmap:
- while (size > 0) {
- if ((bitmap & 1) == 0) {
- thread((StgClosure **)p);
- }
- p++;
- bitmap = bitmap >> 1;
- size--;
- }
+ p = thread_small_bitmap(p, size, bitmap);
break;
}
return p;
@@ -287,7 +294,7 @@ thread_stack(StgPtr p, StgPtr stack_end)
{
const StgRetInfoTable* info;
StgWord bitmap;
- W_ size;
+ StgWord size;
// highly similar to scavenge_stack, but we do pointer threading here.
@@ -315,19 +322,11 @@ thread_stack(StgPtr p, StgPtr stack_end)
p++;
// NOTE: the payload starts immediately after the info-ptr, we
// don't have an StgHeader in the same sense as a heap closure.
- while (size > 0) {
- if ((bitmap & 1) == 0) {
- thread((StgClosure **)p);
- }
- p++;
- bitmap = bitmap >> 1;
- size--;
- }
+ p = thread_small_bitmap(p, size, bitmap);
continue;
case RET_BCO: {
StgBCO *bco;
- nat size;
p++;
bco = (StgBCO *)*p;
@@ -395,14 +394,7 @@ thread_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
default:
bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
small_bitmap:
- while (size > 0) {
- if ((bitmap & 1) == 0) {
- thread((StgClosure **)p);
- }
- p++;
- bitmap = bitmap >> 1;
- size--;
- }
+ p = thread_small_bitmap(p, size, bitmap);
break;
}
@@ -773,7 +765,7 @@ update_fwd_compact( bdescr *blocks )
#endif
bdescr *bd, *free_bd;
StgInfoTable *info;
- nat size;
+ StgWord size;
StgWord iptr;
bd = blocks;
@@ -858,7 +850,8 @@ update_bkwd_compact( generation *gen )
#endif
bdescr *bd, *free_bd;
StgInfoTable *info;
- W_ size, free_blocks;
+ StgWord size;
+ W_ free_blocks;
StgWord iptr;
bd = free_bd = gen->old_blocks;
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index d22a31eccb..dabcd722d7 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -286,6 +286,9 @@ GarbageCollect (nat collect_gen,
memInventory(DEBUG_gc);
#endif
+ // do this *before* we start scavenging
+ collectFreshWeakPtrs();
+
// check sanity *before* GC
IF_DEBUG(sanity, checkSanity(rtsFalse /* before GC */, major_gc));
@@ -1038,8 +1041,6 @@ gcWorkerThread (Capability *cap)
SET_GCT(gc_threads[cap->no]);
gct->id = osThreadId();
- stat_gcWorkerThreadStart(gct);
-
// Wait until we're told to wake up
RELEASE_SPIN_LOCK(&gct->mut_spin);
// yieldThread();
@@ -1097,9 +1098,6 @@ gcWorkerThread (Capability *cap)
ACQUIRE_SPIN_LOCK(&gct->mut_spin);
debugTrace(DEBUG_gc, "GC thread %d on my way...", gct->thread_index);
- // record the time spent doing GC in the Task structure
- stat_gcWorkerThreadDone(gct);
-
SET_GCT(saved_gct);
}
diff --git a/rts/sm/GCThread.h b/rts/sm/GCThread.h
index 12ef999a9b..84ce3f0239 100644
--- a/rts/sm/GCThread.h
+++ b/rts/sm/GCThread.h
@@ -77,7 +77,7 @@
------------------------------------------------------------------------- */
typedef struct gen_workspace_ {
- generation * gen; // the gen for this workspace
+ generation * gen; // the gen for this workspace
struct gc_thread_ * my_gct; // the gc_thread that contains this workspace
// where objects to be scavenged go
@@ -184,7 +184,6 @@ typedef struct gc_thread_ {
Time gc_start_cpu; // process CPU time
Time gc_start_elapsed; // process elapsed time
- Time gc_start_thread_cpu; // thread CPU time
W_ gc_start_faults;
// -------------------
diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c
index 4e0c1369a1..0324f3b4b9 100644
--- a/rts/sm/MarkWeak.c
+++ b/rts/sm/MarkWeak.c
@@ -25,6 +25,8 @@
#include "Storage.h"
#include "Threads.h"
+#include "sm/Sanity.h"
+
/* -----------------------------------------------------------------------------
Weak Pointers
@@ -39,10 +41,8 @@
new live weak pointers, then all the currently unreachable ones are
dead.
- For generational GC: we just don't try to finalize weak pointers in
- older generations than the one we're collecting. This could
- probably be optimised by keeping per-generation lists of weak
- pointers, but for a few weak pointers this scheme will work.
+ For generational GC: we don't try to finalize weak pointers in
+ older generations than the one we're collecting.
There are three distinct stages to processing weak pointers:
@@ -343,6 +343,39 @@ static void tidyThreadList (generation *gen)
}
}
+#ifdef DEBUG
+static void checkWeakPtrSanity(StgWeak *hd, StgWeak *tl)
+{
+ StgWeak *w, *prev;
+ for (w = hd; w != NULL; prev = w, w = w->link) {
+ ASSERT(INFO_PTR_TO_STRUCT(UNTAG_CLOSURE((StgClosure*)w)->header.info)->type == WEAK);
+ checkClosure((StgClosure*)w);
+ }
+ if (tl != NULL) {
+ ASSERT(prev == tl);
+ }
+}
+#endif
+
+void collectFreshWeakPtrs()
+{
+ nat i;
+ generation *gen = &generations[0];
+ // move recently allocated weak_ptr_list to the old list as well
+ for (i = 0; i < n_capabilities; i++) {
+ Capability *cap = capabilities[i];
+ if (cap->weak_ptr_list_tl != NULL) {
+ IF_DEBUG(sanity, checkWeakPtrSanity(cap->weak_ptr_list_hd, cap->weak_ptr_list_tl));
+ cap->weak_ptr_list_tl->link = gen->weak_ptr_list;
+ gen->weak_ptr_list = cap->weak_ptr_list_hd;
+ cap->weak_ptr_list_tl = NULL;
+ cap->weak_ptr_list_hd = NULL;
+ } else {
+ ASSERT(cap->weak_ptr_list_hd == NULL);
+ }
+ }
+}
+
/* -----------------------------------------------------------------------------
Evacuate every weak pointer object on the weak_ptr_list, and update
the link fields.
diff --git a/rts/sm/MarkWeak.h b/rts/sm/MarkWeak.h
index f9bacfa0da..bd0231d74c 100644
--- a/rts/sm/MarkWeak.h
+++ b/rts/sm/MarkWeak.h
@@ -20,6 +20,7 @@ extern StgWeak *old_weak_ptr_list;
extern StgTSO *resurrected_threads;
extern StgTSO *exception_threads;
+void collectFreshWeakPtrs ( void );
void initWeakForGC ( void );
rtsBool traverseWeakPtrList ( void );
void markWeakPtrList ( void );
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index c35444bbaa..b9f8f1259b 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -32,7 +32,7 @@ static void scavenge_stack (StgPtr p, StgPtr stack_end);
static void scavenge_large_bitmap (StgPtr p,
StgLargeBitmap *large_bitmap,
- nat size );
+ StgWord size );
#if defined(THREADED_RTS) && !defined(PARALLEL_GC)
# define evacuate(a) evacuate1(a)
@@ -168,6 +168,20 @@ static StgPtr scavenge_mut_arr_ptrs_marked (StgMutArrPtrs *a)
return (StgPtr)a + mut_arr_ptrs_sizeW(a);
}
+STATIC_INLINE StgPtr
+scavenge_small_bitmap (StgPtr p, StgWord size, StgWord bitmap)
+{
+ while (size > 0) {
+ if ((bitmap & 1) == 0) {
+ evacuate((StgClosure **)p);
+ }
+ p++;
+ bitmap = bitmap >> 1;
+ size--;
+ }
+ return p;
+}
+
/* -----------------------------------------------------------------------------
Blocks of function args occur on the stack (at the top) and
in PAPs.
@@ -178,7 +192,7 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
{
StgPtr p;
StgWord bitmap;
- nat size;
+ StgWord size;
p = (StgPtr)args;
switch (fun_info->f.fun_type) {
@@ -195,14 +209,7 @@ scavenge_arg_block (StgFunInfoTable *fun_info, StgClosure **args)
bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
size = BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
small_bitmap:
- while (size > 0) {
- if ((bitmap & 1) == 0) {
- evacuate((StgClosure **)p);
- }
- p++;
- bitmap = bitmap >> 1;
- size--;
- }
+ p = scavenge_small_bitmap(p, size, bitmap);
break;
}
return p;
@@ -234,14 +241,7 @@ scavenge_PAP_payload (StgClosure *fun, StgClosure **payload, StgWord size)
default:
bitmap = BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
small_bitmap:
- while (size > 0) {
- if ((bitmap & 1) == 0) {
- evacuate((StgClosure **)p);
- }
- p++;
- bitmap = bitmap >> 1;
- size--;
- }
+ p = scavenge_small_bitmap(p, size, bitmap);
break;
}
return p;
@@ -1498,7 +1498,7 @@ scavenge_one(StgPtr p)
{
StgPtr start = gen->scan;
bdescr *start_bd = gen->scan_bd;
- nat size = 0;
+ StgWord size = 0;
scavenge(&gen);
if (start_bd != gen->scan_bd) {
size += (P_)BLOCK_ROUND_UP(start) - start;
@@ -1745,7 +1745,7 @@ scavenge_static(void)
-------------------------------------------------------------------------- */
static void
-scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
+scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, StgWord size )
{
nat i, j, b;
StgWord bitmap;
@@ -1765,19 +1765,6 @@ scavenge_large_bitmap( StgPtr p, StgLargeBitmap *large_bitmap, nat size )
}
}
-STATIC_INLINE StgPtr
-scavenge_small_bitmap (StgPtr p, nat size, StgWord bitmap)
-{
- while (size > 0) {
- if ((bitmap & 1) == 0) {
- evacuate((StgClosure **)p);
- }
- p++;
- bitmap = bitmap >> 1;
- size--;
- }
- return p;
-}
/* -----------------------------------------------------------------------------
scavenge_stack walks over a section of stack and evacuates all the
@@ -1790,7 +1777,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
{
const StgRetInfoTable* info;
StgWord bitmap;
- nat size;
+ StgWord size;
/*
* Each time around this loop, we are looking at a chunk of stack
@@ -1874,7 +1861,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
case RET_BCO: {
StgBCO *bco;
- nat size;
+ StgWord size;
p++;
evacuate((StgClosure **)p);
@@ -1889,7 +1876,7 @@ scavenge_stack(StgPtr p, StgPtr stack_end)
// large bitmap (> 32 entries, or > 64 on a 64-bit machine)
case RET_BIG:
{
- nat size;
+ StgWord size;
size = GET_LARGE_BITMAP(&info->i)->size;
p++;
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 86bd1c2bb3..379d9da769 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -686,7 +686,15 @@ StgPtr allocate (Capability *cap, W_ n)
CCS_ALLOC(cap->r.rCCCS,n);
if (n >= LARGE_OBJECT_THRESHOLD/sizeof(W_)) {
- W_ req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
+ // The largest number of words such that
+ // the computation of req_blocks will not overflow.
+ W_ max_words = (HS_WORD_MAX & ~(BLOCK_SIZE-1)) / sizeof(W_);
+ W_ req_blocks;
+
+ if (n > max_words)
+ req_blocks = HS_WORD_MAX; // signal overflow below
+ else
+ req_blocks = (W_)BLOCK_ROUND_UP(n*sizeof(W_)) / BLOCK_SIZE;
// Attempting to allocate an object larger than maxHeapSize
// should definitely be disallowed. (bug #1791)
diff --git a/rts/win32/libHSbase.def b/rts/win32/libHSbase.def
index 119237b652..8140528c70 100644
--- a/rts/win32/libHSbase.def
+++ b/rts/win32/libHSbase.def
@@ -40,5 +40,4 @@ EXPORTS
base_ControlziExceptionziBase_nonTermination_closure
base_ControlziExceptionziBase_nestedAtomically_closure
-
-
+ base_GHCziEventziThread_blockedOnBadFD_closure
View Lorry Controller Status