diff options
| -rw-r--r-- | rts/RtsAPI.c | 6 | ||||
| -rw-r--r-- | rts/Task.c | 1 | ||||
| -rw-r--r-- | rts/Task.h | 3 | ||||
| -rw-r--r-- | rts/Weak.c | 23 |
4 files changed, 23 insertions, 10 deletions
diff --git a/rts/RtsAPI.c b/rts/RtsAPI.c index 6e6621841e..2479f2038a 100644 --- a/rts/RtsAPI.c +++ b/rts/RtsAPI.c @@ -538,7 +538,9 @@ rts_lock (void) Capability *cap; Task *task; - if (running_finalizers) { + task = newBoundTask(); + + if (task->running_finalizers) { errorBelch("error: a C finalizer called back into Haskell.\n" " This was previously allowed, but is disallowed in GHC 6.10.2 and later.\n" " To create finalizers that may call back into Haskell, use\n" @@ -546,8 +548,6 @@ rts_lock (void) stg_exit(EXIT_FAILURE); } - task = newBoundTask(); - cap = NULL; waitForReturnCapability(&cap, task); return (Capability *)cap; diff --git a/rts/Task.c b/rts/Task.c index 9707251ca3..98f083c112 100644 --- a/rts/Task.c +++ b/rts/Task.c @@ -153,6 +153,7 @@ newTask (rtsBool worker) task->cap = NULL; task->worker = worker; task->stopped = rtsFalse; + task->running_finalizers = rtsFalse; task->stat = NoStatus; task->ret = NULL; task->n_spare_incalls = 0; diff --git a/rts/Task.h b/rts/Task.h index c2b58f2c45..2e0a4b83fa 100644 --- a/rts/Task.h +++ b/rts/Task.h @@ -134,6 +134,9 @@ typedef struct Task_ { rtsBool worker; // == rtsTrue if this is a worker Task rtsBool stopped; // this task has stopped or exited Haskell + // So that we can detect when a finalizer illegally calls back into Haskell + rtsBool running_finalizers; + SchedulerStatus stat; // return status StgClosure ** ret; // return value diff --git a/rts/Weak.c b/rts/Weak.c index 94bead3752..5546514243 100644 --- a/rts/Weak.c +++ b/rts/Weak.c @@ -21,9 +21,6 @@ StgWeak *weak_ptr_list; -// So that we can detect when a finalizer illegally calls back into Haskell -rtsBool running_finalizers = rtsFalse; - void runCFinalizer(void *fn, void *ptr, void *env, StgWord flag) { @@ -37,8 +34,12 @@ void runAllCFinalizers(StgWeak *list) { StgWeak *w; + Task *task; - running_finalizers = rtsTrue; + task = myTask(); + if (task != NULL) { + task->running_finalizers = rtsTrue; + } for (w = list; w; w = w->link) { StgArrWords *farr; @@ -52,7 +53,9 @@ runAllCFinalizers(StgWeak *list) farr->payload[3]); } - running_finalizers = rtsFalse; + if (task != NULL) { + task->running_finalizers = rtsFalse; + } } /* @@ -78,8 +81,12 @@ scheduleFinalizers(Capability *cap, StgWeak *list) StgMutArrPtrs *arr; StgWord size; nat n, i; + Task *task; - running_finalizers = rtsTrue; + task = myTask(); + if (task != NULL) { + task->running_finalizers = rtsTrue; + } // count number of finalizers, and kill all the weak pointers first... n = 0; @@ -114,7 +121,9 @@ scheduleFinalizers(Capability *cap, StgWeak *list) SET_HDR(w, &stg_DEAD_WEAK_info, w->header.prof.ccs); } - running_finalizers = rtsFalse; + if (task != NULL) { + task->running_finalizers = rtsFalse; + } // No finalizers to run? if (n == 0) return; |