From: simonmar <unknown>
Date: Thu, 10 Nov 2005 16:14:01 +0000 (+0000)
Subject: [project @ 2005-11-10 16:14:01 by simonmar]
X-Git-Tag: Initial_conversion_from_CVS_complete~52
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=84b434c5c07ce864353cdf9780873555daad3b47;p=ghc-hetmet.git

[project @ 2005-11-10 16:14:01 by simonmar]
Fix a crash in STM; we were releasing ownership of the transaction too
early in stmWait(), so a TSO could be woken up before we had finished
putting it to sleep properly.
---

diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h
index da92c6f..1d381e6 100644
--- a/ghc/includes/StgMiscClosures.h
+++ b/ghc/includes/StgMiscClosures.h
@@ -466,6 +466,7 @@ RTS_ENTRY(stg_block_async_ret);
 RTS_FUN(stg_block_async_void);
 RTS_ENTRY(stg_block_async_void_ret);
 #endif
+RTS_FUN(stg_block_stmwait);
 
 /* Entry/exit points from StgStartup.cmm */
 
diff --git a/ghc/rts/HeapStackCheck.cmm b/ghc/rts/HeapStackCheck.cmm
index cf70e34..9b55937 100644
--- a/ghc/rts/HeapStackCheck.cmm
+++ b/ghc/rts/HeapStackCheck.cmm
@@ -947,3 +947,18 @@ stg_block_async_void
 }
 
 #endif
+
+/* -----------------------------------------------------------------------------
+   STM-specific waiting
+   -------------------------------------------------------------------------- */
+
+stg_block_stmwait_finally
+{
+    foreign "C" stmWaitUnlock(MyCapability() "ptr", R3 "ptr");
+    jump StgReturn;
+}
+
+stg_block_stmwait
+{
+    BLOCK_BUT_FIRST(stg_block_stmwait_finally);
+}
diff --git a/ghc/rts/PrimOps.cmm b/ghc/rts/PrimOps.cmm
index 630319f..b4e95f3 100644
--- a/ghc/rts/PrimOps.cmm
+++ b/ghc/rts/PrimOps.cmm
@@ -1300,7 +1300,8 @@ retry_pop_stack:
     IF_NOT_REG_R1(Sp_adj(-2); 
 		  Sp(1) = stg_NO_FINALIZER_closure;
 		  Sp(0) = stg_ut_1_0_unreg_info;)
-    jump stg_block_noregs;
+    R3 = trec; // passing to stmWaitUnblock()
+    jump stg_block_stmwait;
   } else {
     // Transaction was not valid: retry immediately
     "ptr" trec = foreign "C" stmStartTransaction(MyCapability() "ptr", outer "ptr");
diff --git a/ghc/rts/STM.c b/ghc/rts/STM.c
index 282ab74..15369cb 100644
--- a/ghc/rts/STM.c
+++ b/ghc/rts/STM.c
@@ -116,7 +116,11 @@
 
 #if defined(DEBUG)
 #define SHAKE
+#if defined(THREADED_RTS)
+#define TRACE(_x...) IF_DEBUG(stm, debugBelch("STM  (task %p): ", (void *)(unsigned long)(unsigned int)osThreadId()); debugBelch ( _x ))
+#else
 #define TRACE(_x...) IF_DEBUG(stm, debugBelch ( _x ))
+#endif
 #else
 #define TRACE(_x...) /*Nothing*/
 #endif
@@ -386,19 +390,6 @@ static StgTRecHeader *new_stg_trec_header(Capability *cap,
   return result;  
 }
 
-static StgTVar *new_tvar(Capability *cap,
-                         StgClosure *new_value) {
-  StgTVar *result;
-  result = (StgTVar *)allocateLocal(cap, sizeofW(StgTVar));
-  SET_HDR (result, &stg_TVAR_info, CCS_SYSTEM);
-  result -> current_value = new_value;
-  result -> first_wait_queue_entry = END_STM_WAIT_QUEUE;
-#if defined(SMP)
-  result -> last_update_by = NO_TREC;
-#endif
-  return result;
-}
-
 /*......................................................................*/
 
 // Helper functions for managing waiting lists
@@ -793,11 +784,13 @@ StgBool stmCommitTransaction(Capability *cap, StgTRecHeader *trec) {
 
   TRACE("%p : stmCommitTransaction()\n", trec);
   ASSERT (trec != NO_TREC);
+
+  lock_stm(trec);
+
   ASSERT (trec -> enclosing_trec == NO_TREC);
   ASSERT ((trec -> state == TREC_ACTIVE) || 
           (trec -> state == TREC_CONDEMNED));
 
-  lock_stm(trec);
   result = validate_and_acquire_ownership(trec, (!use_read_phase), TRUE);
   if (result) {
     // We now know that all the updated locations hold their expected values.
@@ -919,18 +912,29 @@ StgBool stmWait(Capability *cap, StgTSO *tso, StgTRecHeader *trec) {
     park_tso(tso);
     trec -> state = TREC_WAITING;
 
-    // As soon as we start releasing ownership, another thread may find us 
-    // and wake us up.  This may happen even before we have finished 
-    // releasing ownership.
-    revert_ownership(trec, TRUE);
-  }  
+    // We haven't released ownership of the transaction yet.  The TSO
+    // has been put on the wait queue for the TVars it is waiting for,
+    // but we haven't yet tidied up the TSO's stack and made it safe
+    // to wake up the TSO.  Therefore, we must wait until the TSO is
+    // safe to wake up before we release ownership - when all is well,
+    // the runtime will call stmWaitUnlock() below, with the same
+    // TRec.
 
-  unlock_stm(trec);
+  } else {
+    unlock_stm(trec);
+  }
 
   TRACE("%p : stmWait(%p)=%d\n", trec, tso, result);
   return result;
 }
 
+
+void
+stmWaitUnlock(Capability *cap, StgTRecHeader *trec) {
+    revert_ownership(trec, TRUE);
+    unlock_stm(trec);
+}
+
 /*......................................................................*/
 
 StgBool stmReWait(StgTSO *tso) {
@@ -1090,9 +1094,14 @@ void stmWriteTVar(Capability *cap,
 StgTVar *stmNewTVar(Capability *cap,
                     StgClosure *new_value) {
   StgTVar *result;
-  result = new_tvar(cap, new_value);
+  result = (StgTVar *)allocateLocal(cap, sizeofW(StgTVar));
+  SET_HDR (result, &stg_TVAR_info, CCS_SYSTEM);
+  result -> current_value = new_value;
+  result -> first_wait_queue_entry = END_STM_WAIT_QUEUE;
+#if defined(SMP)
+  result -> last_update_by = NO_TREC;
+#endif
   return result;
 }
 
 /*......................................................................*/
-