X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FPrimOps.cmm;h=2e81c1a1fc069065e99e12652a0ef5ded0c48fff;hb=25cc1d1f2d9bf9a83725e49884bd83ab35000e3e;hp=84b81dc46b45948e0c6673b1419d72f8aab9586e;hpb=d3d69395401d3e7be7a8794e0b6850e608a30a24;p=ghc-hetmet.git

diff --git a/ghc/rts/PrimOps.cmm b/ghc/rts/PrimOps.cmm
index 84b81dc..2e81c1a 100644
--- a/ghc/rts/PrimOps.cmm
+++ b/ghc/rts/PrimOps.cmm
@@ -100,7 +100,7 @@ newArrayzh_fast
     "ptr" arr = foreign "C" allocateLocal(MyCapability() "ptr",words) [];
     TICK_ALLOC_PRIM(SIZEOF_StgMutArrPtrs, WDS(n), 0);
 
-    SET_HDR(arr, stg_MUT_ARR_PTRS_info, W_[CCCS]);
+    SET_HDR(arr, stg_MUT_ARR_PTRS_DIRTY_info, W_[CCCS]);
     StgMutArrPtrs_ptrs(arr) = n;
 
     // Initialise all elements of the the array with the value in R2
@@ -137,12 +137,12 @@ unsafeThawArrayzh_fast
   // multiple times during GC, which would be unnecessarily slow.
   //
   if (StgHeader_info(R1) != stg_MUT_ARR_PTRS_FROZEN0_info) {
-	SET_INFO(R1,stg_MUT_ARR_PTRS_info);
+	SET_INFO(R1,stg_MUT_ARR_PTRS_DIRTY_info);
 	foreign "C" recordMutableLock(R1 "ptr") [R1];
 	// must be done after SET_INFO, because it ASSERTs closure_MUTABLE()
 	RET_P(R1);
   } else {
-	SET_INFO(R1,stg_MUT_ARR_PTRS_info);
+	SET_INFO(R1,stg_MUT_ARR_PTRS_DIRTY_info);
 	RET_P(R1);
   }
 }
@@ -159,7 +159,7 @@ newMutVarzh_fast
     ALLOC_PRIM( SIZEOF_StgMutVar, R1_PTR, newMutVarzh_fast);
 
     mv = Hp - SIZEOF_StgMutVar + WDS(1);
-    SET_HDR(mv,stg_MUT_VAR_info,W_[CCCS]);
+    SET_HDR(mv,stg_MUT_VAR_DIRTY_info,W_[CCCS]);
     StgMutVar_var(mv) = R1;
     
     RET_P(mv);
@@ -206,8 +206,8 @@ atomicModifyMutVarzh_fast
 
    HP_CHK_GEN_TICKY(SIZE, R1_PTR & R2_PTR, atomicModifyMutVarzh_fast);
 
-#if defined(SMP)
-    foreign "C" ACQUIRE_LOCK(sm_mutex "ptr");
+#if defined(THREADED_RTS)
+    foreign "C" ACQUIRE_LOCK(atomic_modify_mutvar_mutex "ptr") [R1,R2];
 #endif
 
    x = StgMutVar_var(R1);
@@ -228,6 +228,7 @@ atomicModifyMutVarzh_fast
    StgThunk_payload(y,0) = z;
 
    StgMutVar_var(R1) = y;
+   foreign "C" dirty_MUT_VAR(BaseReg "ptr", R1 "ptr") [R1];
 
    TICK_ALLOC_THUNK_1();
    CCCS_ALLOC(THUNK_1_SIZE);
@@ -236,8 +237,8 @@ atomicModifyMutVarzh_fast
    LDV_RECORD_CREATE(r);
    StgThunk_payload(r,0) = z;
 
-#if defined(SMP)
-    foreign "C" RELEASE_LOCK(sm_mutex "ptr") [];
+#if defined(THREADED_RTS)
+    foreign "C" RELEASE_LOCK(atomic_modify_mutvar_mutex "ptr") [];
 #endif
 
    RET_P(r);
@@ -511,7 +512,7 @@ word64ToIntegerzh_fast
 
 /* ToDo: this is shockingly inefficient */
 
-#ifndef SMP
+#ifndef THREADED_RTS
 section "bss" {
   mp_tmp1:
     bits8 [SIZEOF_MP_INT];
@@ -533,7 +534,7 @@ section "bss" {
 }
 #endif
 
-#ifdef SMP
+#ifdef THREADED_RTS
 #define FETCH_MP_TEMP(X) \
 W_ X; \
 X = BaseReg + (OFFSET_StgRegTable_r ## X);
@@ -654,7 +655,7 @@ GMP_TAKE1_RET1(complementIntegerzh_fast, mpz_com)
 GMP_TAKE2_RET2(quotRemIntegerzh_fast, mpz_tdiv_qr)
 GMP_TAKE2_RET2(divModIntegerzh_fast,  mpz_fdiv_qr)
 
-#ifndef SMP
+#ifndef THREADED_RTS
 section "bss" {
   mp_tmp_w:  W_; // NB. mp_tmp_w is really an here mp_limb_t
 }
@@ -1172,6 +1173,14 @@ atomicallyzh_fast
   /* Args: R1 = m :: STM a */
   STK_CHK_GEN(SIZEOF_StgAtomicallyFrame + WDS(1), R1_PTR, atomicallyzh_fast);
 
+  old_trec = StgTSO_trec(CurrentTSO);
+
+  /* Nested transactions are not allowed; raise an exception */
+  if (old_trec != NO_TREC) {
+     R1 = GHCziIOBase_NestedAtomically_closure;
+     jump raisezh_fast;
+  }
+
   /* Set up the atomically frame */
   Sp = Sp - SIZEOF_StgAtomicallyFrame;
   frame = Sp;
@@ -1180,8 +1189,6 @@ atomicallyzh_fast
   StgAtomicallyFrame_code(frame) = R1;
 
   /* Start the memory transcation */
-  old_trec = StgTSO_trec(CurrentTSO);
-  ASSERT(old_trec == NO_TREC);
   "ptr" new_trec = foreign "C" stmStartTransaction(MyCapability() "ptr", old_trec "ptr");
   StgTSO_trec(CurrentTSO) = new_trec;
 
@@ -1462,7 +1469,7 @@ takeMVarzh_fast
     /* args: R1 = MVar closure */
     mvar = R1;
 
-#if defined(SMP)
+#if defined(THREADED_RTS)
     "ptr" info = foreign "C" lockClosure(mvar "ptr");
 #else
     info = GET_INFO(mvar);
@@ -1513,7 +1520,7 @@ takeMVarzh_fast
 	  StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
       }
 
-#if defined(SMP)
+#if defined(THREADED_RTS)
       foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info);
 #endif
       RET_P(val);
@@ -1523,7 +1530,7 @@ takeMVarzh_fast
       /* No further putMVars, MVar is now empty */
       StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
  
-#if defined(SMP)
+#if defined(THREADED_RTS)
       foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info);
 #else
       SET_INFO(mvar,stg_EMPTY_MVAR_info);
@@ -1542,14 +1549,14 @@ tryTakeMVarzh_fast
 
     mvar = R1;
 
-#if defined(SMP)
+#if defined(THREADED_RTS)
     "ptr" info = foreign "C" lockClosure(mvar "ptr");
 #else
     info = GET_INFO(mvar);
 #endif
 
     if (info == stg_EMPTY_MVAR_info) {
-#if defined(SMP)
+#if defined(THREADED_RTS)
         foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info);
 #endif
 	/* HACK: we need a pointer to pass back, 
@@ -1585,7 +1592,7 @@ tryTakeMVarzh_fast
 	if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
 	    StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
 	}
-#if defined(SMP)
+#if defined(THREADED_RTS)
         foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info);
 #endif
     }
@@ -1593,7 +1600,7 @@ tryTakeMVarzh_fast
     {
 	/* No further putMVars, MVar is now empty */
 	StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
-#if defined(SMP)
+#if defined(THREADED_RTS)
     	foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info);
 #else
 	SET_INFO(mvar,stg_EMPTY_MVAR_info);
@@ -1611,7 +1618,7 @@ putMVarzh_fast
     /* args: R1 = MVar, R2 = value */
     mvar = R1;
 
-#if defined(SMP)
+#if defined(THREADED_RTS)
     "ptr" info = foreign "C" lockClosure(mvar "ptr");
 #else
     info = GET_INFO(mvar);
@@ -1654,7 +1661,7 @@ putMVarzh_fast
 	    StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
 	}
 
-#if defined(SMP)
+#if defined(THREADED_RTS)
     	foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info);
 #endif
 	jump %ENTRY_CODE(Sp(0));
@@ -1664,7 +1671,7 @@ putMVarzh_fast
 	/* No further takes, the MVar is now full. */
 	StgMVar_value(mvar) = R2;
 
-#if defined(SMP)
+#if defined(THREADED_RTS)
     	foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info);
 #else
 	SET_INFO(mvar,stg_FULL_MVAR_info);
@@ -1683,14 +1690,14 @@ tryPutMVarzh_fast
     /* args: R1 = MVar, R2 = value */
     mvar = R1;
 
-#if defined(SMP)
+#if defined(THREADED_RTS)
     "ptr" info = foreign "C" lockClosure(mvar "ptr");
 #else
     info = GET_INFO(mvar);
 #endif
 
     if (info == stg_FULL_MVAR_info) {
-#if defined(SMP)
+#if defined(THREADED_RTS)
     	foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info);
 #endif
 	RET_N(0);
@@ -1719,24 +1726,23 @@ tryPutMVarzh_fast
 	    StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
 	}
 
-#if defined(SMP)
+#if defined(THREADED_RTS)
     	foreign "C" unlockClosure(mvar "ptr", stg_EMPTY_MVAR_info);
 #endif
-	jump %ENTRY_CODE(Sp(0));
     }
     else
     {
 	/* No further takes, the MVar is now full. */
 	StgMVar_value(mvar) = R2;
 
-#if defined(SMP)
+#if defined(THREADED_RTS)
     	foreign "C" unlockClosure(mvar "ptr", stg_FULL_MVAR_info);
 #else
 	SET_INFO(mvar,stg_FULL_MVAR_info);
 #endif
-	jump %ENTRY_CODE(Sp(0));
     }
     
+    RET_N(1);
     /* ToDo: yield afterward for better communication performance? */
 }