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
("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);
}
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
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);
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);
}
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;
// 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);
// 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);
}
// 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));
/* 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) {
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);
}
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 );
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;
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) {
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;
projects / ghc-hetmet.git / blobdiff