Fix crash in nested callbacks (#4038)

[ghc-hetmet.git] / rts / Task.c

diff --git a/rts/Task.c b/rts/Task.c
index 2921e9e..a9461c9 100644 (file)
--- a/rts/Task.c
+++ b/rts/Task.c
@@ -153,8 +153,7 @@ newTask (rtsBool worker)
     task->cap           = NULL;
     task->worker        = worker;
     task->stopped       = rtsFalse;
-    task->stat          = NoStatus;
-    task->ret           = NULL;
+    task->running_finalizers = rtsFalse;
     task->n_spare_incalls = 0;
     task->spare_incalls = NULL;
     task->incall        = NULL;
@@ -210,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;
@@ -280,17 +281,19 @@ boundTaskExiting (Task *task)
 void
 discardTasksExcept (Task *keep)
 {
-    Task *task;
+    Task *task, *next;
 
     // Wipe the task list, except the current Task.
     ACQUIRE_LOCK(&sched_mutex);
-    for (task = all_tasks; task != NULL; task=task->all_link) {
+    for (task = all_tasks; task != NULL; task=next) {
+        next = task->all_link;
         if (task != keep) {
             debugTrace(DEBUG_sched, "discarding task %ld", (long)TASK_ID(task));
             freeTask(task);
         }
     }
     all_tasks = keep;
+    keep->all_link = NULL;
     RELEASE_LOCK(&sched_mutex);
 }