diff options
Diffstat (limited to 'rts')
| -rw-r--r-- | rts/Schedule.c | 7 | ||||
| -rw-r--r-- | rts/Weak.c | 11 | ||||
| -rw-r--r-- | rts/Weak.h | 2 |
3 files changed, 20 insertions, 0 deletions
diff --git a/rts/Schedule.c b/rts/Schedule.c index d22d48fb8f..978adb89c8 100644 --- a/rts/Schedule.c +++ b/rts/Schedule.c @@ -32,6 +32,7 @@ #include "Proftimer.h" #include "ProfHeap.h" #include "GC.h" +#include "Weak.h" /* PARALLEL_HASKELL includes go here */ @@ -281,6 +282,12 @@ schedule (Capability *initialCapability, Task *task) "### NEW SCHEDULER LOOP (task: %p, cap: %p)", task, initialCapability); + if (running_finalizers) { + errorBelch("error: a C finalizer called back into Haskell.\n" + " use Foreign.Concurrent.newForeignPtr for Haskell finalizers."); + stg_exit(EXIT_FAILURE); + } + schedulePreLoop(); // ----------------------------------------------------------- diff --git a/rts/Weak.c b/rts/Weak.c index a50a72e59c..17150f6b3c 100644 --- a/rts/Weak.c +++ b/rts/Weak.c @@ -22,6 +22,9 @@ StgWeak *weak_ptr_list; +// So that we can detect when a finalizer illegally calls back into Haskell +rtsBool running_finalizers = rtsFalse; + void runCFinalizer(StgVoid *fn, StgVoid *ptr, StgVoid *env, StgWord flag) { @@ -36,6 +39,8 @@ runAllCFinalizers(StgWeak *list) { StgWeak *w; + running_finalizers = rtsTrue; + for (w = list; w; w = w->link) { StgArrWords *farr; @@ -47,6 +52,8 @@ runAllCFinalizers(StgWeak *list) (StgVoid *)farr->payload[2], farr->payload[3]); } + + running_finalizers = rtsFalse; } /* @@ -72,6 +79,8 @@ scheduleFinalizers(Capability *cap, StgWeak *list) StgMutArrPtrs *arr; nat n; + running_finalizers = rtsTrue; + // count number of finalizers, and kill all the weak pointers first... n = 0; for (w = list; w; w = w->link) { @@ -105,6 +114,8 @@ scheduleFinalizers(Capability *cap, StgWeak *list) SET_HDR(w, &stg_DEAD_WEAK_info, w->header.prof.ccs); } + running_finalizers = rtsFalse; + // No finalizers to run? if (n == 0) return; diff --git a/rts/Weak.h b/rts/Weak.h index cf93b4df9e..8fccae2a63 100644 --- a/rts/Weak.h +++ b/rts/Weak.h @@ -11,6 +11,8 @@ #include "Capability.h" +extern rtsBool running_finalizers; + void runCFinalizer(StgVoid *fn, StgVoid *ptr, StgVoid *env, StgWord flag); void runAllCFinalizers(StgWeak *w); void scheduleFinalizers(Capability *cap, StgWeak *w); |