X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FException.hc;h=e5389677f832a9c6dfc476b57129d7f2d4c25eca;hb=167eb5b4cad9aacaf242347126af568184087d0b;hp=ce7ba7a3ef91440cd36fce3414884f4eae203b39;hpb=a1750cd6e46e39fb18cfd9bf490c7f8c3c074a53;p=ghc-hetmet.git

diff --git a/ghc/rts/Exception.hc b/ghc/rts/Exception.hc
index ce7ba7a..e538967 100644
--- a/ghc/rts/Exception.hc
+++ b/ghc/rts/Exception.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Exception.hc,v 1.5 2000/01/22 18:00:03 simonmar Exp $
+ * $Id: Exception.hc,v 1.13 2000/04/26 09:44:18 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -17,6 +17,9 @@
 #if defined(PAR)
 # include "FetchMe.h"
 #endif
+#if defined(PROFILING)
+# include "Profiling.h"
+#endif
 
 /* -----------------------------------------------------------------------------
    Exception Primitives
@@ -52,9 +55,11 @@ FN_(blockAsyncExceptionszh_fast)
     if (CurrentTSO->blocked_exceptions == NULL) {
       CurrentTSO->blocked_exceptions = END_TSO_QUEUE;
       /* avoid growing the stack unnecessarily */
-      if (Sp[0] != (W_)&blockAsyncExceptionszh_ret_info) {
+      if (Sp[0] == (W_)&blockAsyncExceptionszh_ret_info) {
+	Sp++;
+      } else {
 	Sp--;
-	Sp[0] = (W_)&blockAsyncExceptionszh_ret_info;
+	Sp[0] = (W_)&unblockAsyncExceptionszh_ret_info;
       }
     }
     Sp--;
@@ -80,8 +85,14 @@ FN_(unblockAsyncExceptionszh_ret_entry)
     awakenBlockedQueue(CurrentTSO->blocked_exceptions);
 #endif
     CurrentTSO->blocked_exceptions = NULL;
+#ifdef REG_R1
     Sp++;
     JMP_(ENTRY_CODE(Sp[0]));
+#else
+    Sp[1] = Sp[0];
+    Sp++;
+    JMP_(ENTRY_CODE(Sp[1]));
+#endif
   FE_
 }
 
@@ -106,7 +117,9 @@ FN_(unblockAsyncExceptionszh_fast)
       CurrentTSO->blocked_exceptions = NULL;
 
       /* avoid growing the stack unnecessarily */
-      if (Sp[0] != (W_)&blockAsyncExceptionszh_ret_info) {
+      if (Sp[0] == (W_)&unblockAsyncExceptionszh_ret_info) {
+	Sp++;
+      } else {
 	Sp--;	
 	Sp[0] = (W_)&blockAsyncExceptionszh_ret_info;
       }
@@ -123,12 +136,17 @@ FN_(blockAsyncExceptionszh_ret_entry)
   FB_
     ASSERT(CurrentTSO->blocked_exceptions == NULL);
     CurrentTSO->blocked_exceptions = END_TSO_QUEUE;
+#ifdef REG_R1
     Sp++;
     JMP_(ENTRY_CODE(Sp[0]));
+#else
+    Sp[1] = Sp[0];
+    Sp++;
+    JMP_(ENTRY_CODE(Sp[1]));
+#endif
   FE_
 }
 
-
 FN_(killThreadzh_fast)
 {
   FB_
@@ -137,25 +155,27 @@ FN_(killThreadzh_fast)
   /* This thread may have been relocated.
    * (see Schedule.c:threadStackOverflow)
    */
-  while (R1.t->whatNext == ThreadRelocated) {
+  while (R1.t->what_next == 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.
+   * we'll have to block until it's ready to accept them.  The
+   * exception is interruptible threads - ie. those that are blocked
+   * on some resource.
    */
-  if (R1.t->blocked_exceptions != NULL) {
-
-	/* ToDo (SMP): locking if destination thread is currently
-	 * running...
-	 */
-	CurrentTSO->link = R1.t->blocked_exceptions;
-	R1.t->blocked_exceptions = CurrentTSO;
-
-        CurrentTSO->why_blocked = BlockedOnException;
-        CurrentTSO->block_info.tso = R1.t;
+  if (R1.t->blocked_exceptions != NULL && !interruptible(R1.t) ) {
+    
+    /* ToDo (SMP): locking if destination thread is currently
+     * running...
+     */
+    CurrentTSO->link = R1.t->blocked_exceptions;
+    R1.t->blocked_exceptions = CurrentTSO;
 
-        BLOCK( R1_PTR | R2_PTR, killThreadzh_fast );
+    CurrentTSO->why_blocked = BlockedOnException;
+    CurrentTSO->block_info.tso = R1.t;
+    
+    BLOCK( R1_PTR | R2_PTR, killThreadzh_fast );
   }
 
   /* Killed threads turn into zombies, which might be garbage
@@ -171,12 +191,12 @@ FN_(killThreadzh_fast)
   if (R1.t == CurrentTSO) {
 	SaveThreadState();	/* inline! */
 	STGCALL2(raiseAsync, R1.t, R2.cl);
-	if (CurrentTSO->whatNext == ThreadKilled) {
-		R1.w = ThreadYielding;
+	if (CurrentTSO->what_next == ThreadKilled) {
+		R1.w = ThreadFinished;
 		JMP_(StgReturn);
 	}
 	LoadThreadState();
-	if (CurrentTSO->whatNext == ThreadEnterGHC) {
+	if (CurrentTSO->what_next == ThreadEnterGHC) {
 		R1.w = Sp[0];
 		Sp++;
 		JMP_(GET_ENTRY(R1.cl));
@@ -195,6 +215,7 @@ FN_(killThreadzh_fast)
    Catch frames
    -------------------------------------------------------------------------- */
 
+#ifdef REG_R1
 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) 	\
    FN_(label);					\
    FN_(label)					\
@@ -205,16 +226,38 @@ FN_(killThreadzh_fast)
       JMP_(ret);				\
       FE_					\
    }
+#else
+#define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) 	\
+   FN_(label);					\
+   FN_(label)					\
+   {						\
+      StgWord rval;				\
+      FB_					\
+      rval = Sp[0];				\
+      Sp++;					\
+      Su = ((StgCatchFrame *)Sp)->link;		\
+      Sp += sizeofW(StgCatchFrame) - 1;		\
+      Sp[0] = rval;				\
+      JMP_(ret);				\
+      FE_					\
+   }
+#endif
 
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_entry,ENTRY_CODE(Sp[0]));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_0_entry,RET_VEC(Sp[0],0));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_1_entry,RET_VEC(Sp[0],1));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_2_entry,RET_VEC(Sp[0],2));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_3_entry,RET_VEC(Sp[0],3));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_4_entry,RET_VEC(Sp[0],4));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_5_entry,RET_VEC(Sp[0],5));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_6_entry,RET_VEC(Sp[0],6));
-CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_7_entry,RET_VEC(Sp[0],7));
+#ifdef REG_R1
+#define SP_OFF 0
+#else
+#define SP_OFF 1
+#endif
+
+CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_entry,ENTRY_CODE(Sp[SP_OFF]));
+CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_0_entry,RET_VEC(Sp[SP_OFF],0));
+CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_1_entry,RET_VEC(Sp[SP_OFF],1));
+CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_2_entry,RET_VEC(Sp[SP_OFF],2));
+CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_3_entry,RET_VEC(Sp[SP_OFF],3));
+CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_4_entry,RET_VEC(Sp[SP_OFF],4));
+CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_5_entry,RET_VEC(Sp[SP_OFF],5));
+CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_6_entry,RET_VEC(Sp[SP_OFF],6));
+CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_7_entry,RET_VEC(Sp[SP_OFF],7));
 
 #ifdef PROFILING
 #define CATCH_FRAME_BITMAP 7
@@ -243,8 +286,8 @@ INFO_TABLE(catch_info,catch_entry,2,0,FUN,,EF_,0,0);
 STGFUN(catch_entry)
 {
   FB_
-  R2.cl = payloadCPtr(R1.cl,1); /* h */
-  R1.cl = payloadCPtr(R1.cl,0); /* x */
+  R2.cl = R1.cl->payload[1]; /* h */
+  R1.cl = R1.cl->payload[0]; /* x */
   JMP_(catchzh_fast);
   FE_
 }
@@ -254,8 +297,10 @@ FN_(catchzh_fast)
   StgCatchFrame *fp;
   FB_
 
-    /* args: R1 = m, R2 = handler */
-    STK_CHK_GEN(sizeofW(StgCatchFrame), R1_PTR | R2_PTR, catchzh_fast, );
+    /* args: R1 = m :: IO a, R2 = handler :: Exception -> IO a */
+    STK_CHK_GEN(sizeofW(StgCatchFrame) + 1, R1_PTR | R2_PTR, catchzh_fast, );
+  
+    /* Set up the catch frame */
     Sp -= sizeofW(StgCatchFrame);
     fp = (StgCatchFrame *)Sp;
     SET_HDR(fp,(StgInfoTable *)&catch_frame_info,CCCS);
@@ -264,6 +309,10 @@ FN_(catchzh_fast)
     fp -> link = Su;
     Su = (StgUpdateFrame *)fp;
     TICK_CATCHF_PUSHED();
+
+    /* Push realworld token and enter R1. */
+    Sp--;
+    Sp[0] = ARG_TAG(0);
     TICK_ENT_VIA_NODE();
     JMP_(GET_ENTRY(R1.cl));
     
@@ -295,7 +344,7 @@ FN_(raisezh_fast)
   StgUpdateFrame *p;
   StgClosure *raise_closure;
   FB_
-    /* args : R1 = error */
+    /* args : R1 = exception */
 
 
 #if defined(PROFILING)
@@ -340,8 +389,15 @@ FN_(raisezh_fast)
 	break;
 
       case STOP_FRAME:
-	barf("raisezh_fast: STOP_FRAME");
-
+	/* We've stripped the entire stack, the thread is now dead. */
+	Sp = CurrentTSO->stack + CurrentTSO->stack_size - 1;
+	Sp[0] = R1.w;		/* save the exception */
+	Su = (StgUpdateFrame *)(Sp+1);
+	CurrentTSO->what_next = ThreadKilled;
+	SaveThreadState();	/* inline! */
+	R1.w = ThreadFinished;
+	JMP_(StgReturn);
+      
       default:
 	barf("raisezh_fast: weird activation record");
       }
@@ -356,7 +412,7 @@ FN_(raisezh_fast)
     Su = ((StgCatchFrame *)p)->link; 
     handler = ((StgCatchFrame *)p)->handler;
     
-    Sp = (P_)p + sizeofW(StgCatchFrame) - 1;
+    Sp = (P_)p + sizeofW(StgCatchFrame);
 
     /* Restore the blocked/unblocked state for asynchronous exceptions
      * at the CATCH_FRAME.  
@@ -366,7 +422,7 @@ FN_(raisezh_fast)
      * unblockAsyncExceptions_ret stack frame.
      */
     if (! ((StgCatchFrame *)p)->exceptions_blocked) {
-      *(Sp--) = (W_)&unblockAsyncExceptionszh_ret_info;
+      *(--Sp) = (W_)&unblockAsyncExceptionszh_ret_info;
     }
 
     /* Ensure that async excpetions are blocked when running the handler.
@@ -375,9 +431,12 @@ FN_(raisezh_fast)
       CurrentTSO->blocked_exceptions = END_TSO_QUEUE;
     }
 
-    /* Enter the handler, passing the exception value as an argument.
+    /* Enter the handler, passing the exception value and a realworld
+     * token as arguments.
      */
-    *Sp = R1.w;
+    Sp -= 2;
+    Sp[0] = R1.w;
+    Sp[1] = ARG_TAG(0);
     TICK_ENT_VIA_NODE();
     R1.cl = handler;
     JMP_(GET_ENTRY(R1.cl));