From: simonmar <unknown>
Date: Wed, 26 Apr 2000 09:44:38 +0000 (+0000)
Subject: [project @ 2000-04-26 09:44:18 by simonmar]
X-Git-Tag: Approximately_9120_patches~4609
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=0938c182dc6801d1cef414e8d61dc084557fc6f1;p=ghc-hetmet.git

[project @ 2000-04-26 09:44:18 by simonmar]
raisezh_fast now handles uncaught exceptions cleanly.  The affected
thread is marked as Killed, and if it is a main thread then
rts_evalIO() will return ThreadKilled as it should.
---

diff --git a/ghc/rts/Exception.hc b/ghc/rts/Exception.hc
index 3231f50..e538967 100644
--- a/ghc/rts/Exception.hc
+++ b/ghc/rts/Exception.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: Exception.hc,v 1.12 2000/04/14 16:47:43 panne Exp $
+ * $Id: Exception.hc,v 1.13 2000/04/26 09:44:18 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -192,7 +192,7 @@ FN_(killThreadzh_fast)
 	SaveThreadState();	/* inline! */
 	STGCALL2(raiseAsync, R1.t, R2.cl);
 	if (CurrentTSO->what_next == ThreadKilled) {
-		R1.w = ThreadYielding;
+		R1.w = ThreadFinished;
 		JMP_(StgReturn);
 	}
 	LoadThreadState();
@@ -344,7 +344,7 @@ FN_(raisezh_fast)
   StgUpdateFrame *p;
   StgClosure *raise_closure;
   FB_
-    /* args : R1 = error */
+    /* args : R1 = exception */
 
 
 #if defined(PROFILING)
@@ -389,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");
       }
diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index db8bb2e..90e71f7 100644
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
 /* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.68 2000/04/14 16:47:43 panne Exp $
+ * $Id: Schedule.c,v 1.69 2000/04/26 09:44:28 simonmar Exp $
  *
  * (c) The GHC Team, 1998-2000
  *
@@ -971,7 +971,9 @@ schedule( void )
 			 t->id, t, whatNext_strs[t->what_next]);
                }
                );
+
       threadPaused(t);
+
       IF_DEBUG(sanity,
 	       //belch("&& Doing sanity check on yielding TSO %ld.", t->id);
 	       checkTSO(t));
@@ -1054,8 +1056,10 @@ schedule( void )
        * more main threads, we probably need to stop all the tasks until
        * we get a new one.
        */
+      /* We also end up here if the thread kills itself with an
+       * uncaught exception, see Exception.hc.
+       */
       IF_DEBUG(scheduler,belch("--++ thread %d (%p) finished", t->id, t));
-      t->what_next = ThreadComplete;
 #if defined(GRAN)
       endThread(t, CurrentProc); // clean-up the thread
 #elif defined(PAR)
diff --git a/ghc/rts/StgStartup.hc b/ghc/rts/StgStartup.hc
index c927de9..147baa0 100644
--- a/ghc/rts/StgStartup.hc
+++ b/ghc/rts/StgStartup.hc
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: StgStartup.hc,v 1.11 2000/04/03 16:28:08 simonmar Exp $
+ * $Id: StgStartup.hc,v 1.12 2000/04/26 09:44:38 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -82,6 +82,8 @@ STGFUN(stg_stop_thread_entry)
     Su = (StgUpdateFrame *)(Sp+1);  
     Sp[0] = R1.w;
 
+    CurrentTSO->what_next = ThreadComplete;
+
     SaveThreadState();	/* inline! */
 
     /* R1 contains the return value of the thread */