summaryrefslogtreecommitdiff
path: root/rts
diff options
context:
space:
mode:
authorSimon Marlow <marlowsd@gmail.com>2010-05-07 09:32:22 +0000
committerSimon Marlow <marlowsd@gmail.com>2010-05-07 09:32:22 +0000
commit2007d2138cf17efe6a1701510dbafdfc30e8926c (patch)
treebbee43dbaa8f3061ddbd6b6a8a27d0bb791654fd /rts
parent3c6190b0beb551f7637e7edbd1bbff803af3a79e (diff)
downloadhaskell-2007d2138cf17efe6a1701510dbafdfc30e8926c.tar.gz
Fix crash in nested callbacks (#4038)
Broken by "Split part of the Task struct into a separate struct InCall".
Diffstat (limited to 'rts')
-rw-r--r--rts/RtsAPI.c4
-rw-r--r--rts/Schedule.c22
-rw-r--r--rts/Task.c4
-rw-r--r--rts/Task.h6
4 files changed, 18 insertions, 18 deletions
diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c
index 2479f2038a..fb9c0107a0 100644
--- a/rts/RtsAPI.c
+++ b/rts/RtsAPI.c
@@ -510,7 +510,7 @@ rts_evalLazyIO_ (Capability *cap, HaskellObj p, unsigned int stack_size,
void
rts_checkSchedStatus (char* site, Capability *cap)
{
- SchedulerStatus rc = cap->running_task->stat;
+ SchedulerStatus rc = cap->running_task->incall->stat;
switch (rc) {
case Success:
return;
@@ -529,7 +529,7 @@ rts_checkSchedStatus (char* site, Capability *cap)
SchedulerStatus
rts_getSchedStatus (Capability *cap)
{
- return cap->running_task->stat;
+ return cap->running_task->incall->stat;
}
Capability *
diff --git a/rts/Schedule.c b/rts/Schedule.c
index b350ade5fa..66a13883f0 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -1235,23 +1235,23 @@ scheduleHandleThreadFinished (Capability *cap STG_UNUSED, Task *task, StgTSO *t)
ASSERT(task->incall->tso == t);
if (t->what_next == ThreadComplete) {
- if (task->ret) {
+ if (task->incall->ret) {
// NOTE: return val is tso->sp[1] (see StgStartup.hc)
- *(task->ret) = (StgClosure *)task->incall->tso->sp[1];
+ *(task->incall->ret) = (StgClosure *)task->incall->tso->sp[1];
}
- task->stat = Success;
+ task->incall->stat = Success;
} else {
- if (task->ret) {
- *(task->ret) = NULL;
+ if (task->incall->ret) {
+ *(task->incall->ret) = NULL;
}
if (sched_state >= SCHED_INTERRUPTING) {
if (heap_overflow) {
- task->stat = HeapExhausted;
+ task->incall->stat = HeapExhausted;
} else {
- task->stat = Interrupted;
+ task->incall->stat = Interrupted;
}
} else {
- task->stat = Killed;
+ task->incall->stat = Killed;
}
}
#ifdef DEBUG
@@ -1887,8 +1887,8 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability *cap)
tso->cap = cap;
task->incall->tso = tso;
- task->ret = ret;
- task->stat = NoStatus;
+ task->incall->ret = ret;
+ task->incall->stat = NoStatus;
appendToRunQueue(cap,tso);
@@ -1897,7 +1897,7 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability *cap)
cap = schedule(cap,task);
- ASSERT(task->stat != NoStatus);
+ ASSERT(task->incall->stat != NoStatus);
ASSERT_FULL_CAPABILITY_INVARIANTS(cap,task);
debugTrace(DEBUG_sched, "bound thread (%lu) finished", (unsigned long)id);
diff --git a/rts/Task.c b/rts/Task.c
index 98f083c112..a9461c9527 100644
--- a/rts/Task.c
+++ b/rts/Task.c
@@ -154,8 +154,6 @@ newTask (rtsBool worker)
task->worker = worker;
task->stopped = rtsFalse;
task->running_finalizers = rtsFalse;
- task->stat = NoStatus;
- task->ret = NULL;
task->n_spare_incalls = 0;
task->spare_incalls = NULL;
task->incall = NULL;
@@ -211,6 +209,8 @@ newInCall (Task *task)
incall->task = task;
incall->suspended_tso = NULL;
incall->suspended_cap = NULL;
+ incall->stat = NoStatus;
+ incall->ret = NULL;
incall->next = NULL;
incall->prev = NULL;
incall->prev_stack = task->incall;
diff --git a/rts/Task.h b/rts/Task.h
index 2e0a4b83fa..17a443ad6b 100644
--- a/rts/Task.h
+++ b/rts/Task.h
@@ -83,6 +83,9 @@ typedef struct InCall_ {
// without owning a Capability in the
// first place.
+ SchedulerStatus stat; // return status
+ StgClosure ** ret; // return value
+
struct Task_ *task;
// When a Haskell thread makes a foreign call that re-enters
@@ -137,9 +140,6 @@ typedef struct Task_ {
// So that we can detect when a finalizer illegally calls back into Haskell
rtsBool running_finalizers;
- SchedulerStatus stat; // return status
- StgClosure ** ret; // return value
-
// Stats that we collect about this task
// ToDo: we probably want to put this in a separate TaskStats
// structure, so we can share it between multiple Tasks. We don't