stg_takeMVarzh
{
- W_ mvar, val, info, tso;
+ W_ mvar, val, info, tso, q;
/* args: R1 = MVar closure */
mvar = R1;
* and wait until we're woken up.
*/
if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
+
+ // Note [mvar-heap-check] We want to do the heap check in the
+ // branch here, to avoid the conditional in the common case.
+ // However, we've already locked the MVar above, so we better
+ // be careful to unlock it again if the the heap check fails.
+ // Unfortunately we don't have an easy way to inject any code
+ // into the heap check generated by the code generator, so we
+ // have to do it in stg_gc_gen (see HeapStackCheck.cmm).
+ HP_CHK_GEN_TICKY(SIZEOF_StgMVarTSOQueue, R1_PTR, stg_takeMVarzh);
+
+ q = Hp - SIZEOF_StgMVarTSOQueue + WDS(1);
+
+ StgHeader_info(q) = stg_MVAR_TSO_QUEUE_info;
+ StgMVarTSOQueue_link(q) = END_TSO_QUEUE;
+ StgMVarTSOQueue_tso(q) = CurrentTSO;
+
if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
- StgMVar_head(mvar) = CurrentTSO;
+ StgMVar_head(mvar) = q;
} else {
- foreign "C" setTSOLink(MyCapability() "ptr",
- StgMVar_tail(mvar) "ptr",
- CurrentTSO) [];
+ StgMVarTSOQueue_link(StgMVar_tail(mvar)) = q;
+ foreign "C" recordClosureMutated(MyCapability() "ptr",
+ StgMVar_tail(mvar)) [];
}
- StgTSO__link(CurrentTSO) = stg_END_TSO_QUEUE_closure;
+ StgTSO__link(CurrentTSO) = q;
StgTSO_block_info(CurrentTSO) = mvar;
- // write barrier for throwTo(), which looks at block_info
- // if why_blocked==BlockedOnMVar.
- prim %write_barrier() [];
StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
- StgMVar_tail(mvar) = CurrentTSO;
+ StgMVar_tail(mvar) = q;
R1 = mvar;
jump stg_block_takemvar;
- }
-
- /* we got the value... */
- val = StgMVar_value(mvar);
-
- if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure)
- {
- /* There are putMVar(s) waiting...
- * wake up the first thread on the queue
- */
- ASSERT(StgTSO_why_blocked(StgMVar_head(mvar)) == BlockedOnMVar::I16);
-
- /* actually perform the putMVar for the thread that we just woke up */
- tso = StgMVar_head(mvar);
- PerformPut(tso,StgMVar_value(mvar));
-
- if (TO_W_(StgTSO_dirty(tso)) == 0) {
- foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
- }
-
- ("ptr" tso) = foreign "C" unblockOne_(MyCapability() "ptr",
- StgMVar_head(mvar) "ptr", 1) [];
- StgMVar_head(mvar) = tso;
-
- if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
- StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
- }
-
- unlockClosure(mvar, stg_MVAR_DIRTY_info);
- RET_P(val);
- }
- else
- {
- /* No further putMVars, MVar is now empty */
- StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
-
- unlockClosure(mvar, stg_MVAR_DIRTY_info);
+ }
+
+ /* we got the value... */
+ val = StgMVar_value(mvar);
+
+ q = StgMVar_head(mvar);
+loop:
+ if (q == stg_END_TSO_QUEUE_closure) {
+ /* No further putMVars, MVar is now empty */
+ StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
+ RET_P(val);
+ }
+ if (StgHeader_info(q) == stg_IND_info ||
+ StgHeader_info(q) == stg_MSG_NULL_info) {
+ q = StgInd_indirectee(q);
+ goto loop;
+ }
+
+ // There are putMVar(s) waiting... wake up the first thread on the queue
+
+ tso = StgMVarTSOQueue_tso(q);
+ 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));
+
+ StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
+ if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
+ StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
+ }
+
+ // indicate that the putMVar 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.
- RET_P(val);
- }
+ foreign "C" tryWakeupThread(MyCapability() "ptr", tso) [];
+
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
+ RET_P(val);
}
stg_tryTakeMVarzh
{
- W_ mvar, val, info, tso;
+ W_ mvar, val, info, tso, q;
/* args: R1 = MVar closure */
-
mvar = R1;
#if defined(THREADED_RTS)
#else
info = GET_INFO(mvar);
#endif
-
+
+ /* If the MVar is empty, put ourselves on its blocking queue,
+ * and wait until we're woken up.
+ */
if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
#if defined(THREADED_RTS)
unlockClosure(mvar, info);
*/
RET_NP(0, stg_NO_FINALIZER_closure);
}
-
+
if (info == stg_MVAR_CLEAN_info) {
- foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr");
+ foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr") [];
}
/* we got the value... */
val = StgMVar_value(mvar);
-
- if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure) {
-
- /* There are putMVar(s) waiting...
- * wake up the first thread on the queue
- */
- ASSERT(StgTSO_why_blocked(StgMVar_head(mvar)) == BlockedOnMVar::I16);
-
- /* actually perform the putMVar for the thread that we just woke up */
- tso = StgMVar_head(mvar);
- PerformPut(tso,StgMVar_value(mvar));
- if (TO_W_(StgTSO_dirty(tso)) == 0) {
- foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
- }
-
- ("ptr" tso) = foreign "C" unblockOne_(MyCapability() "ptr",
- StgMVar_head(mvar) "ptr", 1) [];
- StgMVar_head(mvar) = tso;
-
- if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
- StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
- }
+
+ q = StgMVar_head(mvar);
+loop:
+ if (q == stg_END_TSO_QUEUE_closure) {
+ /* No further putMVars, MVar is now empty */
+ StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
unlockClosure(mvar, stg_MVAR_DIRTY_info);
+ RET_NP(1, val);
}
- else
- {
- /* No further putMVars, MVar is now empty */
- StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
- unlockClosure(mvar, stg_MVAR_DIRTY_info);
+ if (StgHeader_info(q) == stg_IND_info ||
+ StgHeader_info(q) == stg_MSG_NULL_info) {
+ q = StgInd_indirectee(q);
+ goto loop;
}
- RET_NP(1, val);
+ // There are putMVar(s) waiting... wake up the first thread on the queue
+
+ tso = StgMVarTSOQueue_tso(q);
+ 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));
+
+ StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
+ if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
+ StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
+ }
+
+ // indicate that the putMVar 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) [];
+
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
+ RET_P(val);
}
stg_putMVarzh
{
- W_ mvar, val, info, tso;
+ W_ mvar, val, info, tso, q;
/* args: R1 = MVar, R2 = value */
mvar = R1;
}
if (StgMVar_value(mvar) != stg_END_TSO_QUEUE_closure) {
+
+ // see Note [mvar-heap-check] above
+ HP_CHK_GEN_TICKY(SIZEOF_StgMVarTSOQueue, R1_PTR, stg_putMVarzh);
+
+ q = Hp - SIZEOF_StgMVarTSOQueue + WDS(1);
+
+ StgHeader_info(q) = stg_MVAR_TSO_QUEUE_info;
+ StgMVarTSOQueue_link(q) = END_TSO_QUEUE;
+ StgMVarTSOQueue_tso(q) = CurrentTSO;
+
if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
- StgMVar_head(mvar) = CurrentTSO;
+ StgMVar_head(mvar) = q;
} else {
- foreign "C" setTSOLink(MyCapability() "ptr",
- StgMVar_tail(mvar) "ptr",
- CurrentTSO) [];
+ StgMVarTSOQueue_link(StgMVar_tail(mvar)) = q;
+ foreign "C" recordClosureMutated(MyCapability() "ptr",
+ StgMVar_tail(mvar)) [];
}
- StgTSO__link(CurrentTSO) = stg_END_TSO_QUEUE_closure;
+ StgTSO__link(CurrentTSO) = q;
StgTSO_block_info(CurrentTSO) = mvar;
- // write barrier for throwTo(), which looks at block_info
- // if why_blocked==BlockedOnMVar.
- prim %write_barrier() [];
StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
- StgMVar_tail(mvar) = CurrentTSO;
-
+ StgMVar_tail(mvar) = q;
+
R1 = mvar;
R2 = val;
jump stg_block_putmvar;
}
- if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure) {
-
- /* There are takeMVar(s) waiting: wake up the first one
- */
- ASSERT(StgTSO_why_blocked(StgMVar_head(mvar)) == BlockedOnMVar::I16);
-
- /* actually perform the takeMVar */
- tso = StgMVar_head(mvar);
- PerformTake(tso, val);
- if (TO_W_(StgTSO_dirty(tso)) == 0) {
- foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
- }
-
- ("ptr" tso) = foreign "C" unblockOne_(MyCapability() "ptr",
- StgMVar_head(mvar) "ptr", 1) [];
- StgMVar_head(mvar) = tso;
-
- if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
- StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
- }
-
- unlockClosure(mvar, stg_MVAR_DIRTY_info);
- jump %ENTRY_CODE(Sp(0));
- }
- else
- {
+ q = StgMVar_head(mvar);
+loop:
+ if (q == stg_END_TSO_QUEUE_closure) {
/* No further takes, the MVar is now full. */
StgMVar_value(mvar) = val;
-
unlockClosure(mvar, stg_MVAR_DIRTY_info);
jump %ENTRY_CODE(Sp(0));
}
+ if (StgHeader_info(q) == stg_IND_info ||
+ StgHeader_info(q) == stg_MSG_NULL_info) {
+ q = StgInd_indirectee(q);
+ goto loop;
+ }
+
+ // There are takeMVar(s) waiting: wake up the first one
+
+ tso = StgMVarTSOQueue_tso(q);
+ ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16);
+ ASSERT(StgTSO_block_info(tso) == mvar);
+ // actually perform the takeMVar
+ PerformTake(tso, val);
+
+ if (TO_W_(StgTSO_dirty(tso)) == 0) {
+ foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
+ }
+
+ StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
+ if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
+ StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
+ }
+
+ // indicate that the takeMVar has now completed:
+ StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
- /* ToDo: yield afterward for better communication performance? */
+ foreign "C" tryWakeupThread(MyCapability() "ptr", tso) [];
+
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
+ jump %ENTRY_CODE(Sp(0));
}
stg_tryPutMVarzh
{
- W_ mvar, info, tso;
+ W_ mvar, val, info, tso, q;
/* args: R1 = MVar, R2 = value */
mvar = R1;
+ val = R2;
#if defined(THREADED_RTS)
- ("ptr" info) = foreign "C" lockClosure(mvar "ptr") [R2];
+ ("ptr" info) = foreign "C" lockClosure(mvar "ptr") [];
#else
info = GET_INFO(mvar);
#endif
+ if (info == stg_MVAR_CLEAN_info) {
+ foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr");
+ }
+
if (StgMVar_value(mvar) != stg_END_TSO_QUEUE_closure) {
#if defined(THREADED_RTS)
unlockClosure(mvar, info);
RET_N(0);
}
- if (info == stg_MVAR_CLEAN_info) {
- foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr");
- }
-
- if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure) {
-
- /* There are takeMVar(s) waiting: wake up the first one
- */
- ASSERT(StgTSO_why_blocked(StgMVar_head(mvar)) == BlockedOnMVar::I16);
-
- /* actually perform the takeMVar */
- tso = StgMVar_head(mvar);
- PerformTake(tso, R2);
- if (TO_W_(StgTSO_dirty(tso)) == 0) {
- foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
- }
-
- ("ptr" tso) = foreign "C" unblockOne_(MyCapability() "ptr",
- StgMVar_head(mvar) "ptr", 1) [];
- StgMVar_head(mvar) = tso;
-
- if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
- StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
- }
-
+ q = StgMVar_head(mvar);
+loop:
+ if (q == stg_END_TSO_QUEUE_closure) {
+ /* No further takes, the MVar is now full. */
+ StgMVar_value(mvar) = val;
unlockClosure(mvar, stg_MVAR_DIRTY_info);
+ jump %ENTRY_CODE(Sp(0));
+ }
+ if (StgHeader_info(q) == stg_IND_info ||
+ StgHeader_info(q) == stg_MSG_NULL_info) {
+ q = StgInd_indirectee(q);
+ goto loop;
}
- else
- {
- /* No further takes, the MVar is now full. */
- StgMVar_value(mvar) = R2;
- unlockClosure(mvar, stg_MVAR_DIRTY_info);
+ /* There are takeMVar(s) waiting: wake up the first one
+ */
+ // There are takeMVar(s) waiting: wake up the first one
+
+ tso = StgMVarTSOQueue_tso(q);
+ ASSERT(StgTSO_why_blocked(tso) == BlockedOnMVar::I16);
+ ASSERT(StgTSO_block_info(tso) == mvar);
+ // actually perform the takeMVar
+ PerformTake(tso, val);
+
+ if (TO_W_(StgTSO_dirty(tso)) == 0) {
+ foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
}
- RET_N(1);
- /* ToDo: yield afterward for better communication performance? */
+ StgMVar_head(mvar) = StgMVarTSOQueue_link(q);
+ if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
+ StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
+ }
+
+ // indicate that the takeMVar has now completed:
+ StgTSO__link(tso) = stg_END_TSO_QUEUE_closure;
+
+ foreign "C" tryWakeupThread(MyCapability() "ptr", tso) [];
+
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
+ jump %ENTRY_CODE(Sp(0));
}
projects / ghc-hetmet.git / blobdiff