Detect when a C finalizer calls back to Haskell

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.

diff --git a/rts/Schedule.c b/rts/Schedule.c
index d22d48f..978adb8 100644 (file)
--- 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 a50a72e..17150f6 100644 (file)
--- 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 cf93b4d..8fccae2 100644 (file)
--- 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);