X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FPrimOps.cmm;h=4f6c2526d4ecf6c2c7cb5ab3c8e0ec9562769687;hb=8625c675de45bdb8bcfa795572ce7c47687c147c;hp=3c7dbdd0cc77cc967d06cba3c2d85794341e4082;hpb=971c88597b0972053975c9c99aa51764ab75b143;p=ghc-hetmet.git

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 3c7dbdd..4f6c252 100644
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -34,7 +34,7 @@ import pthread_mutex_unlock;
 import base_ControlziExceptionziBase_nestedAtomically_closure;
 import EnterCriticalSection;
 import LeaveCriticalSection;
-import ghczmprim_GHCziBool_False_closure;
+import ghczmprim_GHCziTypes_False_closure;
 #if !defined(mingw32_HOST_OS)
 import sm_mutex;
 #endif
@@ -109,6 +109,11 @@ stg_newAlignedPinnedByteArrayzh
     n = R1;
     alignment = R2;
 
+    /* we always supply at least word-aligned memory, so there's no
+       need to allow extra space for alignment if the requirement is less
+       than a word.  This also prevents mischief with alignment == 0. */
+    if (alignment <= SIZEOF_W) { alignment = 1; }
+
     bytes = n;
 
     /* payload_words is what we will tell the profiler we had to allocate */
@@ -629,11 +634,6 @@ stg_threadStatuszh
     W_ ret;
 
     tso = R1;
-    loop:
-      if (TO_W_(StgTSO_what_next(tso)) == ThreadRelocated) {
-          tso = StgTSO__link(tso);
-          goto loop;
-      }
 
     what_next   = TO_W_(StgTSO_what_next(tso));
     why_blocked = TO_W_(StgTSO_why_blocked(tso));
@@ -934,9 +934,9 @@ stg_retryzh
 
   // Find the enclosing ATOMICALLY_FRAME or CATCH_RETRY_FRAME
 retry_pop_stack:
-  StgTSO_sp(CurrentTSO) = Sp;
-  (frame_type) = foreign "C" findRetryFrameHelper(CurrentTSO "ptr") [];
-  Sp = StgTSO_sp(CurrentTSO);
+  SAVE_THREAD_STATE();
+  (frame_type) = foreign "C" findRetryFrameHelper(MyCapability(), CurrentTSO "ptr") [];
+  LOAD_THREAD_STATE();
   frame = Sp;
   trec = StgTSO_trec(CurrentTSO);
   outer  = StgTRecHeader_enclosing_trec(trec);
@@ -1133,13 +1133,13 @@ stg_newMVarzh
 }
 
 
-#define PerformTake(tso, value)				\
-    W_[StgTSO_sp(tso) + WDS(1)] = value;		\
-    W_[StgTSO_sp(tso) + WDS(0)] = stg_gc_unpt_r1_info;
+#define PerformTake(stack, value)                       \
+    W_[StgStack_sp(stack) + WDS(1)] = value;            \
+    W_[StgStack_sp(stack) + WDS(0)] = stg_gc_unpt_r1_info;
 
-#define PerformPut(tso,lval)			\
-    StgTSO_sp(tso) = StgTSO_sp(tso) + WDS(3);	\
-    lval = W_[StgTSO_sp(tso) - WDS(1)];
+#define PerformPut(stack,lval)                      \
+    StgStack_sp(stack) = StgStack_sp(stack) + WDS(3);   \
+    lval = W_[StgStack_sp(stack) - WDS(1)];
 
 stg_takeMVarzh
 {
@@ -1219,24 +1219,20 @@ loop:
         StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
     }
 
-loop2:
-    if (TO_W_(StgTSO_what_next(tso)) == ThreadRelocated) {
-        tso = StgTSO__link(tso);
-        goto loop2;
-    }
-
     ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16);
     ASSERT(StgTSO_block_info(tso) == mvar);
 
     // actually perform the putMVar for the thread that we just woke up
-    PerformPut(tso,StgMVar_value(mvar));
+    W_ stack;
+    stack = StgTSO_stackobj(tso);
+    PerformPut(stack, StgMVar_value(mvar));
 
     // indicate that the MVar operation has now completed.
     StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
     
     // no need to mark the TSO dirty, we have only written END_TSO_QUEUE.
 
-    foreign "C" tryWakeupThread_(MyCapability() "ptr", tso) [];
+    foreign "C" tryWakeupThread(MyCapability() "ptr", tso) [];
     
     unlockClosure(mvar, stg_MVAR_DIRTY_info);
     RET_P(val);
@@ -1298,27 +1294,23 @@ loop:
         StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
     }
 
-loop2:
-    if (TO_W_(StgTSO_what_next(tso)) == ThreadRelocated) {
-        tso = StgTSO__link(tso);
-        goto loop2;
-    }
-
     ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16);
     ASSERT(StgTSO_block_info(tso) == mvar);
 
     // actually perform the putMVar for the thread that we just woke up
-    PerformPut(tso,StgMVar_value(mvar));
+    W_ stack;
+    stack = StgTSO_stackobj(tso);
+    PerformPut(stack, StgMVar_value(mvar));
 
     // indicate that the MVar operation has now completed.
     StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
     
     // no need to mark the TSO dirty, we have only written END_TSO_QUEUE.
 
-    foreign "C" tryWakeupThread_(MyCapability() "ptr", tso) [];
+    foreign "C" tryWakeupThread(MyCapability() "ptr", tso) [];
     
     unlockClosure(mvar, stg_MVAR_DIRTY_info);
-    RET_P(val);
+    RET_NP(1,val);
 }
 
 
@@ -1390,26 +1382,22 @@ loop:
         StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
     }
 
-loop2:
-    if (TO_W_(StgTSO_what_next(tso)) == ThreadRelocated) {
-        tso = StgTSO__link(tso);
-        goto loop2;
-    }
-
     ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16);
     ASSERT(StgTSO_block_info(tso) == mvar);
 
     // actually perform the takeMVar
-    PerformTake(tso, val);
+    W_ stack;
+    stack = StgTSO_stackobj(tso);
+    PerformTake(stack, val);
 
     // indicate that the MVar operation has now completed.
     StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
-    
-    if (TO_W_(StgTSO_dirty(tso)) == 0) {
-        foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
+
+    if (TO_W_(StgStack_dirty(stack)) == 0) {
+        foreign "C" dirty_STACK(MyCapability() "ptr", stack "ptr") [];
     }
     
-    foreign "C" tryWakeupThread_(MyCapability() "ptr", tso) [];
+    foreign "C" tryWakeupThread(MyCapability() "ptr", tso) [];
 
     unlockClosure(mvar, stg_MVAR_DIRTY_info);
     jump %ENTRY_CODE(Sp(0));
@@ -1447,7 +1435,7 @@ loop:
 	/* No further takes, the MVar is now full. */
 	StgMVar_value(mvar) = val;
     	unlockClosure(mvar, stg_MVAR_DIRTY_info);
-	jump %ENTRY_CODE(Sp(0));
+        RET_N(1);
     }
     if (StgHeader_info(q) == stg_IND_info ||
         StgHeader_info(q) == stg_MSG_NULL_info) {
@@ -1463,29 +1451,25 @@ loop:
         StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
     }
 
-loop2:
-    if (TO_W_(StgTSO_what_next(tso)) == ThreadRelocated) {
-        tso = StgTSO__link(tso);
-        goto loop2;
-    }
-
     ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16);
     ASSERT(StgTSO_block_info(tso) == mvar);
 
     // actually perform the takeMVar
-    PerformTake(tso, val);
+    W_ stack;
+    stack = StgTSO_stackobj(tso);
+    PerformTake(stack, val);
 
     // indicate that the MVar operation has now completed.
     StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
     
-    if (TO_W_(StgTSO_dirty(tso)) == 0) {
-        foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
+    if (TO_W_(StgStack_dirty(stack)) == 0) {
+        foreign "C" dirty_STACK(MyCapability() "ptr", stack "ptr") [];
     }
     
-    foreign "C" tryWakeupThread_(MyCapability() "ptr", tso) [];
+    foreign "C" tryWakeupThread(MyCapability() "ptr", tso) [];
 
     unlockClosure(mvar, stg_MVAR_DIRTY_info);
-    jump %ENTRY_CODE(Sp(0));
+    RET_N(1);
 }
 
 
@@ -2009,13 +1993,13 @@ stg_getSparkzh
    W_ spark;
 
 #ifndef THREADED_RTS
-   RET_NP(0,ghczmprim_GHCziBool_False_closure);
+   RET_NP(0,ghczmprim_GHCziTypes_False_closure);
 #else
    (spark) = foreign "C" findSpark(MyCapability());
    if (spark != 0) {
       RET_NP(1,spark);
    } else {
-      RET_NP(0,ghczmprim_GHCziBool_False_closure);
+      RET_NP(0,ghczmprim_GHCziTypes_False_closure);
    }
 #endif
 }