This is illegal now, after the fix for #1364, but it turns out that
the existing check for dodgy callbacks doesn't catch finalizers
calling back, so we need another test. This will be particularly
important for 6.10.2, because the behaviour has changed.
#include "Proftimer.h"
#include "ProfHeap.h"
#include "GC.h"
#include "Proftimer.h"
#include "ProfHeap.h"
#include "GC.h"
/* PARALLEL_HASKELL includes go here */
/* PARALLEL_HASKELL includes go here */
"### NEW SCHEDULER LOOP (task: %p, cap: %p)",
task, initialCapability);
"### 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();
// -----------------------------------------------------------
schedulePreLoop();
// -----------------------------------------------------------
+// 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)
{
void
runCFinalizer(StgVoid *fn, StgVoid *ptr, StgVoid *env, StgWord flag)
{
+ running_finalizers = rtsTrue;
+
for (w = list; w; w = w->link) {
StgArrWords *farr;
for (w = list; w; w = w->link) {
StgArrWords *farr;
(StgVoid *)farr->payload[2],
farr->payload[3]);
}
(StgVoid *)farr->payload[2],
farr->payload[3]);
}
+
+ running_finalizers = rtsFalse;
StgMutArrPtrs *arr;
nat n;
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) {
// count number of finalizers, and kill all the weak pointers first...
n = 0;
for (w = list; w; w = w->link) {
SET_HDR(w, &stg_DEAD_WEAK_info, w->header.prof.ccs);
}
SET_HDR(w, &stg_DEAD_WEAK_info, w->header.prof.ccs);
}
+ running_finalizers = rtsFalse;
+
// No finalizers to run?
if (n == 0) return;
// No finalizers to run?
if (n == 0) return;
+extern rtsBool running_finalizers;
+
void runCFinalizer(StgVoid *fn, StgVoid *ptr, StgVoid *env, StgWord flag);
void runAllCFinalizers(StgWeak *w);
void scheduleFinalizers(Capability *cap, StgWeak *w);
void runCFinalizer(StgVoid *fn, StgVoid *ptr, StgVoid *env, StgWord flag);
void runAllCFinalizers(StgWeak *w);
void scheduleFinalizers(Capability *cap, StgWeak *w);