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 (file)
--- 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)
 {
 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;
     switch (rc) {
     case Success:
        return;

@@ -529,7 +529,7 @@ rts_checkSchedStatus (char* site, Capability *cap)
 SchedulerStatus
 rts_getSchedStatus (Capability *cap)
 {
 SchedulerStatus
 rts_getSchedStatus (Capability *cap)
 {

-    return cap->running_task->stat;
+    return cap->running_task->incall->stat;

 }
 
 Capability *
 }
 
 Capability *

diff --git a/rts/Schedule.c b/rts/Schedule.c
index b350ade..66a1388 100644 (file)
--- 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) {
          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)
                  // 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 {
          } else {

-             if (task->ret) {
-                 *(task->ret) = NULL;
+             if (task->incall->ret) {
+                 *(task->incall->ret) = NULL;

              }
              if (sched_state >= SCHED_INTERRUPTING) {
                   if (heap_overflow) {
              }
              if (sched_state >= SCHED_INTERRUPTING) {
                   if (heap_overflow) {

-                      task->stat = HeapExhausted;
+                      task->incall->stat = HeapExhausted;

                   } else {
                   } else {

-                      task->stat = Interrupted;
+                      task->incall->stat = Interrupted;

                   }
              } else {
                   }
              } else {

-                 task->stat = Killed;
+                 task->incall->stat = Killed;

              }
          }
 #ifdef DEBUG
              }
          }
 #ifdef DEBUG

@@ -1887,8 +1887,8 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability *cap)
     tso->cap = cap;
 
     task->incall->tso = tso;
     tso->cap = cap;
 
     task->incall->tso = tso;

-    task->ret = ret;
-    task->stat = NoStatus;
+    task->incall->ret = ret;
+    task->incall->stat = NoStatus;

 
     appendToRunQueue(cap,tso);
 
 
     appendToRunQueue(cap,tso);
 

@@ -1897,7 +1897,7 @@ scheduleWaitThread (StgTSO* tso, /*[out]*/HaskellObj* ret, Capability *cap)
 
     cap = schedule(cap,task);
 
 
     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);
     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 (file)
--- 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->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;
     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->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;
     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 (file)
--- a/rts/Task.h
+++ b/rts/Task.h
@@ -83,6 +83,9 @@ typedef struct InCall_ {
                                 // without owning a Capability in the
                                 // first place.
 
                                 // 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
     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;
 
     // 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
     // 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