From: Simon Marlow <marlowsd@gmail.com>
Date: Fri, 7 May 2010 09:32:22 +0000 (+0000)
Subject: Fix crash in nested callbacks (#4038)
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=2007d2138cf17efe6a1701510dbafdfc30e8926c

Fix crash in nested callbacks (#4038)
Broken by "Split part of the Task struct into a separate struct
InCall".
---

diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c
index 2479f20..fb9c010 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 b350ade..66a1388 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 98f083c..a9461c9 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 2e0a4b8..17a443a 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