X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=rts%2FPrimOps.cmm;h=0cf26b2b7fbd957a473aea1b86e7552510433f8e;hb=fff1f6194c3c39de53cd645bda9865fb131b1c68;hp=892ef6830134306c8bc9ce8a55e88a4fce3a6ad1;hpb=a0daca1935e7d07553cac7e3653882fd22e014e2;p=ghc-hetmet.git diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 892ef68..0cf26b2 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 @@ -64,7 +64,7 @@ stg_newByteArrayzh ("ptr" p) = foreign "C" allocate(MyCapability() "ptr",words) []; TICK_ALLOC_PRIM(SIZEOF_StgArrWords,WDS(payload_words),0); SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]); - StgArrWords_words(p) = payload_words; + StgArrWords_bytes(p) = n; RET_P(p); } @@ -73,10 +73,11 @@ stg_newByteArrayzh stg_newPinnedByteArrayzh { - W_ words, bytes, payload_words, p; + W_ words, n, bytes, payload_words, p; MAYBE_GC(NO_PTRS,stg_newPinnedByteArrayzh); - bytes = R1; + n = R1; + bytes = n; /* payload_words is what we will tell the profiler we had to allocate */ payload_words = ROUNDUP_BYTES_TO_WDS(bytes); /* When we actually allocate memory, we need to allow space for the @@ -96,18 +97,25 @@ stg_newPinnedByteArrayzh p = p + ((-p - SIZEOF_StgArrWords) & BA_MASK); SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]); - StgArrWords_words(p) = payload_words; + StgArrWords_bytes(p) = n; RET_P(p); } stg_newAlignedPinnedByteArrayzh { - W_ words, bytes, payload_words, p, alignment; + W_ words, n, bytes, payload_words, p, alignment; MAYBE_GC(NO_PTRS,stg_newAlignedPinnedByteArrayzh); - bytes = R1; + 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 */ payload_words = ROUNDUP_BYTES_TO_WDS(bytes); @@ -129,7 +137,7 @@ stg_newAlignedPinnedByteArrayzh p = p + ((-p - SIZEOF_StgArrWords) & (alignment - 1)); SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]); - StgArrWords_words(p) = payload_words; + StgArrWords_bytes(p) = n; RET_P(p); } @@ -378,7 +386,7 @@ stg_mkWeakForeignEnvzh TICK_ALLOC_PRIM(SIZEOF_StgArrWords,WDS(payload_words),0); SET_HDR(p, stg_ARR_WORDS_info, W_[CCCS]); - StgArrWords_words(p) = payload_words; + StgArrWords_bytes(p) = WDS(payload_words); StgArrWords_payload(p,0) = fptr; StgArrWords_payload(p,1) = ptr; StgArrWords_payload(p,2) = eptr; @@ -1211,22 +1219,29 @@ 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: + +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)); + + // 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); @@ -1283,25 +1298,32 @@ 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: + +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)); + + // 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); } @@ -1326,7 +1348,7 @@ stg_putMVarzh if (StgMVar_value(mvar) != stg_END_TSO_QUEUE_closure) { // see Note [mvar-heap-check] above - HP_CHK_GEN_TICKY(SIZEOF_StgMVarTSOQueue, R1_PTR|R2_PTR, stg_putMVarzh); + HP_CHK_GEN_TICKY(SIZEOF_StgMVarTSOQueue, R1_PTR & R2_PTR, stg_putMVarzh); q = Hp - SIZEOF_StgMVarTSOQueue + WDS(1); @@ -1368,24 +1390,31 @@ loop: // There are takeMVar(s) waiting: wake up the first one tso = StgMVarTSOQueue_tso(q); + StgMVar_head(mvar) = StgMVarTSOQueue_link(q); + if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) { + 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); + // 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") []; } - 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) []; + foreign "C" tryWakeupThread_(MyCapability() "ptr", tso) []; unlockClosure(mvar, stg_MVAR_DIRTY_info); jump %ENTRY_CODE(Sp(0)); @@ -1423,7 +1452,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) { @@ -1431,32 +1460,37 @@ loop: goto loop; } - /* There are takeMVar(s) waiting: wake up the first one - */ // There are takeMVar(s) waiting: wake up the first one tso = StgMVarTSOQueue_tso(q); + StgMVar_head(mvar) = StgMVarTSOQueue_link(q); + if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) { + 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); + // 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") []; } - 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) []; + foreign "C" tryWakeupThread_(MyCapability() "ptr", tso) []; unlockClosure(mvar, stg_MVAR_DIRTY_info); - jump %ENTRY_CODE(Sp(0)); + RET_N(1); } @@ -1522,7 +1556,7 @@ stg_newBCOzh bitmap_arr = R5; - words = BYTES_TO_WDS(SIZEOF_StgBCO) + StgArrWords_words(bitmap_arr); + words = BYTES_TO_WDS(SIZEOF_StgBCO) + BYTE_ARR_WDS(bitmap_arr); bytes = WDS(words); ALLOC_PRIM( bytes, R1_PTR&R2_PTR&R3_PTR&R5_PTR, stg_newBCOzh ); @@ -1540,7 +1574,7 @@ stg_newBCOzh W_ i; i = 0; for: - if (i < StgArrWords_words(bitmap_arr)) { + if (i < BYTE_ARR_WDS(bitmap_arr)) { StgBCO_bitmap(bco,i) = StgArrWords_payload(bitmap_arr,i); i = i + 1; goto for; @@ -1634,7 +1668,7 @@ for: is promoted. */ SET_HDR(nptrs_arr, stg_ARR_WORDS_info, W_[CCCS]); - StgArrWords_words(nptrs_arr) = nptrs; + StgArrWords_bytes(nptrs_arr) = WDS(nptrs); p = 0; for2: if(p < nptrs) { @@ -1980,17 +2014,28 @@ 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 } +stg_numSparkszh +{ + W_ n; +#ifdef THREADED_RTS + (n) = foreign "C" dequeElements(Capability_sparks(MyCapability())); +#else + n = 0; +#endif + RET_N(n); +} + stg_traceEventzh { W_ msg;