X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FPrimOps.cmm;h=373f1925c315f007257d492c7217d40527a92c42;hb=ab89dc190a9004d2ec9547c7e64eab8853ab9837;hp=04a753c51b53cd8a730907fc649ff7952e204bfd;hpb=1ed01a871030f05905a9595e4837dfffc087ef64;p=ghc-hetmet.git diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 04a753c..373f192 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -920,6 +920,12 @@ forkzh_fast ("ptr" threadid) = foreign "C" createIOThread( MyCapability() "ptr", RtsFlags_GcFlags_initialStkSize(RtsFlags), closure "ptr") []; + + /* start blocked if the current thread is blocked */ + StgTSO_flags(threadid) = + StgTSO_flags(threadid) | (StgTSO_flags(CurrentTSO) & + (TSO_BLOCKEX::I32 | TSO_INTERRUPTIBLE::I32)); + foreign "C" scheduleThread(MyCapability() "ptr", threadid "ptr") []; // switch at the earliest opportunity @@ -943,6 +949,12 @@ forkOnzh_fast ("ptr" threadid) = foreign "C" createIOThread( MyCapability() "ptr", RtsFlags_GcFlags_initialStkSize(RtsFlags), closure "ptr") []; + + /* start blocked if the current thread is blocked */ + StgTSO_flags(threadid) = + StgTSO_flags(threadid) | (StgTSO_flags(CurrentTSO) & + (TSO_BLOCKEX::I32 | TSO_INTERRUPTIBLE::I32)); + foreign "C" scheduleThreadOn(MyCapability() "ptr", cpu, threadid "ptr") []; // switch at the earliest opportunity @@ -1498,7 +1510,7 @@ takeMVarzh_fast #endif if (info == stg_MVAR_CLEAN_info) { - foreign "C" dirty_MVAR(BaseReg "ptr", mvar); + foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr"); } /* If the MVar is empty, put ourselves on its blocking queue, @@ -1595,7 +1607,7 @@ tryTakeMVarzh_fast } if (info == stg_MVAR_CLEAN_info) { - foreign "C" dirty_MVAR(BaseReg "ptr", mvar); + foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr"); } /* we got the value... */ @@ -1661,7 +1673,7 @@ putMVarzh_fast #endif if (info == stg_MVAR_CLEAN_info) { - foreign "C" dirty_MVAR(BaseReg "ptr", mvar); + foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr"); } if (StgMVar_value(mvar) != stg_END_TSO_QUEUE_closure) { @@ -1747,7 +1759,7 @@ tryPutMVarzh_fast } if (info == stg_MVAR_CLEAN_info) { - foreign "C" dirty_MVAR(BaseReg "ptr", mvar); + foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr"); } if (StgMVar_head(mvar) != stg_END_TSO_QUEUE_closure) {