[project @ 2000-01-22 18:00:03 by simonmar]

[ghc-hetmet.git] / ghc / rts / Exception.hc

diff --git a/ghc/rts/Exception.hc b/ghc/rts/Exception.hc
index f19f212..ce7ba7a 100644 (file)
--- a/ghc/rts/Exception.hc
+++ b/ghc/rts/Exception.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Exception.hc,v 1.2 1999/12/02 09:52:41 simonmar Exp $
+ * $Id: Exception.hc,v 1.5 2000/01/22 18:00:03 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -14,6 +14,9 @@
 #include "Storage.h"
 #include "RtsUtils.h"
 #include "RtsFlags.h"
+#if defined(PAR)
+# include "FetchMe.h"
+#endif
 
 /* -----------------------------------------------------------------------------
    Exception Primitives
@@ -48,8 +51,11 @@ FN_(blockAsyncExceptionszh_fast)
 
     if (CurrentTSO->blocked_exceptions == NULL) {
       CurrentTSO->blocked_exceptions = END_TSO_QUEUE;
-      Sp--;
-      Sp[0] = (W_)&unblockAsyncExceptionszh_ret_info;
+      /* avoid growing the stack unnecessarily */
+      if (Sp[0] != (W_)&blockAsyncExceptionszh_ret_info) {
+       Sp--;
+       Sp[0] = (W_)&blockAsyncExceptionszh_ret_info;
+      }
     }
     Sp--;
     Sp[0] = ARG_TAG(0);
@@ -62,7 +68,17 @@ FN_(unblockAsyncExceptionszh_ret_entry)
 {
   FB_
     ASSERT(CurrentTSO->blocked_exceptions != NULL);
+#if defined(GRAN)
+      awakenBlockedQueue(CurrentTSO->blocked_exceptions, 
+                        CurrentTSO->block_info.closure);
+#elif defined(PAR)
+      // is CurrentTSO->block_info.closure always set to the node
+      // holding the blocking queue !? -- HWL
+      awakenBlockedQueue(CurrentTSO->blocked_exceptions, 
+                        CurrentTSO->block_info.closure);
+#else
     awakenBlockedQueue(CurrentTSO->blocked_exceptions);
+#endif
     CurrentTSO->blocked_exceptions = NULL;
     Sp++;
     JMP_(ENTRY_CODE(Sp[0]));
@@ -76,10 +92,24 @@ FN_(unblockAsyncExceptionszh_fast)
     STK_CHK_GEN(2, R1_PTR, unblockAsyncExceptionszh_fast, );
 
     if (CurrentTSO->blocked_exceptions != NULL) {
+#if defined(GRAN)
+      awakenBlockedQueue(CurrentTSO->blocked_exceptions, 
+                        CurrentTSO->block_info.closure);
+#elif defined(PAR)
+      // is CurrentTSO->block_info.closure always set to the node
+      // holding the blocking queue !? -- HWL
+      awakenBlockedQueue(CurrentTSO->blocked_exceptions, 
+                        CurrentTSO->block_info.closure);
+#else
       awakenBlockedQueue(CurrentTSO->blocked_exceptions);
+#endif
       CurrentTSO->blocked_exceptions = NULL;
-      Sp--;
-      Sp[0] = (W_)&blockAsyncExceptionszh_ret_info;
+
+      /* avoid growing the stack unnecessarily */
+      if (Sp[0] != (W_)&blockAsyncExceptionszh_ret_info) {
+       Sp--;   
+       Sp[0] = (W_)&blockAsyncExceptionszh_ret_info;
+      }
     }
     Sp--;
     Sp[0] = ARG_TAG(0);
@@ -104,6 +134,13 @@ FN_(killThreadzh_fast)
   FB_
   /* args: R1.p = TSO to kill, R2.p = Exception */
 
+  /* This thread may have been relocated.
+   * (see Schedule.c:threadStackOverflow)
+   */
+  while (R1.t->whatNext == ThreadRelocated) {
+    R1.t = R1.t->link;
+  }
+
   /* If the target thread is currently blocking async exceptions,
    * we'll have to block until it's ready to accept them.
    */