Backported from GHC HEAD to fit GHC 6.12.2 Fri May 7 11:32:22 CEST 2010 Simon Marlow * Fix crash in nested callbacks (#4038) Broken by "Split part of the Task struct into a separate struct InCall". diff -rN -u old-ghc/rts/RtsAPI.c new-ghc/rts/RtsAPI.c --- old-ghc/rts/RtsAPI.c 2010-05-17 19:45:10.811117781 +0200 +++ new-ghc/rts/RtsAPI.c 2010-05-17 19:45:11.172367293 +0200 @@ -510,7 +510,7 @@ 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 @@ SchedulerStatus rts_getSchedStatus (Capability *cap) { - return cap->running_task->stat; + return cap->running_task->incall->stat; } Capability * diff -rN -u old-ghc/rts/Schedule.c new-ghc/rts/Schedule.c --- old-ghc/rts/Schedule.c 2010-05-17 19:45:10.814117674 +0200 +++ new-ghc/rts/Schedule.c 2010-05-17 19:45:11.175367815 +0200 @@ -1235,23 +1235,23 @@ 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 @@ 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 @@ 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 -rN -u old-ghc/rts/Task.c new-ghc/rts/Task.c --- old-ghc/rts/Task.c 2010-05-17 19:45:10.817118126 +0200 +++ new-ghc/rts/Task.c 2010-05-17 19:45:11.211367513 +0200 @@ -153,8 +153,6 @@ task->cap = NULL; task->worker = worker; task->stopped = rtsFalse; - task->stat = NoStatus; - task->ret = NULL; task->n_spare_incalls = 0; task->spare_incalls = NULL; task->incall = NULL; @@ -211,6 +209,8 @@ 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 -rN -u old-ghc/rts/Task.h new-ghc/rts/Task.h --- old-ghc/rts/Task.h 2010-05-17 19:45:10.817118126 +0200 +++ new-ghc/rts/Task.h 2010-05-17 19:45:11.211367513 +0200 @@ -83,6 +83,9 @@ // 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 @@ // 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