From: simonmar <unknown>
Date: Wed, 2 Feb 2005 12:41:50 +0000 (+0000)
Subject: [project @ 2005-02-02 12:41:50 by simonmar]
X-Git-Tag: Initial_conversion_from_CVS_complete~1124
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=268d028c0275b7899c46c61b7b9d8449f4b2427e;p=ghc-hetmet.git

[project @ 2005-02-02 12:41:50 by simonmar]
Add a helpful sanity check: if we try to re-enter the scheduler from
Haskell code without going via suspendThread()/resumeThread(), such as
when you have a 'foreign import unsafe' that should be 'safe', then you
get an error message.
---

diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index ecd47aa..8c0e44e 100644
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -168,6 +168,11 @@ int context_switch = 0;
 /* if this flag is set as well, give up execution */
 rtsBool interrupted = rtsFalse;
 
+/* If this flag is set, we are running Haskell code.  Used to detect
+ * uses of 'foreign import unsafe' that should be 'safe'.
+ */
+rtsBool in_haskell = rtsFalse;
+
 /* Next thread ID to allocate.
  * Locks required: thread_id_mutex
  */
@@ -353,6 +358,15 @@ schedule( StgMainThread *mainThread USED_WHEN_RTS_SUPPORTS_THREADS,
   // We might have a capability, passed in as initialCapability.
   cap = initialCapability;
 
+  // Check whether we have re-entered the RTS from Haskell without
+  // going via suspendThread()/resumeThread (i.e. a 'safe' foreign
+  // call).
+  if (in_haskell) {
+      errorBelch("schedule: re-entered unsafely.\n"
+		 "   Perhaps a 'foreign import unsafe' should be 'safe'?");
+      stg_exit(1);
+  }
+
 #if defined(RTS_SUPPORTS_THREADS)
   //
   // in the threaded case, the capability is either passed in via the
@@ -902,6 +916,7 @@ run_thread:
     prev_what_next = t->what_next;
 
     errno = t->saved_errno;
+    in_haskell = rtsTrue;
 
     switch (prev_what_next) {
 
@@ -923,6 +938,8 @@ run_thread:
       barf("schedule: invalid what_next field");
     }
 
+    in_haskell = rtsFalse;
+
     // The TSO might have moved, so find the new location:
     t = cap->r.rCurrentTSO;
 
@@ -1587,6 +1604,7 @@ suspendThread( StgRegTable *reg )
   RELEASE_LOCK(&sched_mutex);
   
   errno = saved_errno;
+  in_haskell = rtsFalse;
   return tok; 
 }
 
@@ -1633,6 +1651,7 @@ resumeThread( StgInt tok )
   cap->r.rCurrentTSO = tso;
   RELEASE_LOCK(&sched_mutex);
   errno = saved_errno;
+  in_haskell = rtsTrue;
   return &cap->r;
 }