#include "Cmm.h"
#ifdef __PIC__
+#ifndef mingw32_HOST_OS
import __gmpz_init;
import __gmpz_add;
import __gmpz_sub;
import __gmpz_xor;
import __gmpz_ior;
import __gmpz_com;
-import base_GHCziIOBase_NestedAtomically_closure;
+#endif
import pthread_mutex_lock;
import pthread_mutex_unlock;
+#endif
+import base_ControlziExceptionziBase_nestedAtomically_closure;
import EnterCriticalSection;
import LeaveCriticalSection;
-#endif
+import ghczmprim_GHCziBool_False_closure;
/*-----------------------------------------------------------------------------
Array Primitives
atomicModifyMutVarzh_fast
{
- W_ mv, z, x, y, r;
+ W_ mv, f, z, x, y, r, h;
/* Args: R1 :: MutVar#, R2 :: a -> (a,b) */
/* If x is the current contents of the MutVar#, then
HP_CHK_GEN_TICKY(SIZE, R1_PTR & R2_PTR, atomicModifyMutVarzh_fast);
-#if defined(THREADED_RTS)
- ACQUIRE_LOCK(atomic_modify_mutvar_mutex "ptr") [R1,R2];
-#endif
-
- x = StgMutVar_var(R1);
+ mv = R1;
+ f = R2;
TICK_ALLOC_THUNK_2();
CCCS_ALLOC(THUNK_2_SIZE);
z = Hp - THUNK_2_SIZE + WDS(1);
SET_HDR(z, stg_ap_2_upd_info, W_[CCCS]);
LDV_RECORD_CREATE(z);
- StgThunk_payload(z,0) = R2;
- StgThunk_payload(z,1) = x;
+ StgThunk_payload(z,0) = f;
TICK_ALLOC_THUNK_1();
CCCS_ALLOC(THUNK_1_SIZE);
LDV_RECORD_CREATE(y);
StgThunk_payload(y,0) = z;
- StgMutVar_var(R1) = y;
- foreign "C" dirty_MUT_VAR(BaseReg "ptr", R1 "ptr") [R1];
-
TICK_ALLOC_THUNK_1();
CCCS_ALLOC(THUNK_1_SIZE);
r = y - THUNK_1_SIZE;
LDV_RECORD_CREATE(r);
StgThunk_payload(r,0) = z;
-#if defined(THREADED_RTS)
- RELEASE_LOCK(atomic_modify_mutvar_mutex "ptr") [];
+ retry:
+ x = StgMutVar_var(mv);
+ StgThunk_payload(z,1) = x;
+#ifdef THREADED_RTS
+ (h) = foreign "C" cas(mv + SIZEOF_StgHeader + OFFSET_StgMutVar_var, x, y) [];
+ if (h != x) { goto retry; }
+#else
+ StgMutVar_var(mv) = y;
#endif
+ if (GET_INFO(mv) == stg_MUT_VAR_CLEAN_info) {
+ foreign "C" dirty_MUT_VAR(BaseReg "ptr", mv "ptr") [];
+ }
+
RET_P(r);
}
hi = TO_W_(val >> 32);
lo = TO_W_(val);
- if ( hi != 0 && hi != 0xFFFFFFFF ) {
- words_needed = 2;
- } else {
+ if ( hi == 0 || (hi == 0xFFFFFFFF && lo != 0) ) {
// minimum is one word
words_needed = 1;
+ } else {
+ words_needed = 2;
}
ALLOC_PRIM( SIZEOF_StgArrWords + WDS(words_needed),
RET_NNP(W_[mp_tmp_w], TO_W_(MP_INT__mp_size(mp_tmp1)), p);
}
+decodeFloatzuIntzh_fast
+{
+ W_ p;
+ F_ arg;
+ FETCH_MP_TEMP(mp_tmp1);
+ FETCH_MP_TEMP(mp_tmp_w);
+
+ /* arguments: F1 = Float# */
+ arg = F1;
+
+ /* Perform the operation */
+ foreign "C" __decodeFloat_Int(mp_tmp1 "ptr", mp_tmp_w "ptr", arg) [];
+
+ /* returns: (Int# (mantissa), Int# (exponent)) */
+ RET_NN(W_[mp_tmp1], W_[mp_tmp_w]);
+}
+
#define DOUBLE_MANTISSA_SIZE SIZEOF_DOUBLE
#define ARR_SIZE (SIZEOF_StgArrWords + DOUBLE_MANTISSA_SIZE)
RET_NNP(W_[mp_tmp_w], TO_W_(MP_INT__mp_size(mp_tmp1)), p);
}
+decodeDoublezu2Intzh_fast
+{
+ D_ arg;
+ W_ p;
+ FETCH_MP_TEMP(mp_tmp1);
+ FETCH_MP_TEMP(mp_tmp2);
+ FETCH_MP_TEMP(mp_result1);
+ FETCH_MP_TEMP(mp_result2);
+
+ /* arguments: D1 = Double# */
+ arg = D1;
+
+ /* Perform the operation */
+ foreign "C" __decodeDouble_2Int(mp_tmp1 "ptr", mp_tmp2 "ptr",
+ mp_result1 "ptr", mp_result2 "ptr",
+ arg) [];
+
+ /* returns:
+ (Int# (mant sign), Word# (mant high), Word# (mant low), Int# (expn)) */
+ RET_NNNN(W_[mp_tmp1], W_[mp_tmp2], W_[mp_result1], W_[mp_result2]);
+}
+
/* -----------------------------------------------------------------------------
* Concurrency primitives
* -------------------------------------------------------------------------- */
("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
- CInt[context_switch] = 1 :: CInt;
+ Capability_context_switch(MyCapability()) = 1 :: CInt;
RET_P(threadid);
}
("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
- CInt[context_switch] = 1 :: CInt;
+ Capability_context_switch(MyCapability()) = 1 :: CInt;
RET_P(threadid);
}
RET_N(r);
}
+threadStatuszh_fast
+{
+ /* args: R1 :: ThreadId# */
+ W_ tso;
+ W_ why_blocked;
+ W_ what_next;
+ 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));
+ // Note: these two reads are not atomic, so they might end up
+ // being inconsistent. It doesn't matter, since we
+ // only return one or the other. If we wanted to return the
+ // contents of block_info too, then we'd have to do some synchronisation.
+
+ if (what_next == ThreadComplete) {
+ ret = 16; // NB. magic, matches up with GHC.Conc.threadStatus
+ } else {
+ if (what_next == ThreadKilled) {
+ ret = 17;
+ } else {
+ ret = why_blocked;
+ }
+ }
+ RET_N(ret);
+}
/* -----------------------------------------------------------------------------
* TVar primitives
* -------------------------------------------------------------------------- */
-#ifdef REG_R1
#define SP_OFF 0
-#define IF_NOT_REG_R1(x)
-#else
-#define SP_OFF 1
-#define IF_NOT_REG_R1(x) x
-#endif
// Catch retry frame ------------------------------------------------------------
#if defined(PROFILING)
W_ unused1, W_ unused2,
#endif
- W_ unused3, "ptr" W_ unused4, "ptr" W_ unused5)
+ W_ unused3, P_ unused4, P_ unused5)
{
W_ r, frame, trec, outer;
- IF_NOT_REG_R1(W_ rval; rval = Sp(0); Sp_adj(1); )
frame = Sp;
trec = StgTSO_trec(CurrentTSO);
/* Succeeded (either first branch or second branch) */
StgTSO_trec(CurrentTSO) = outer;
Sp = Sp + SIZEOF_StgCatchRetryFrame;
- IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;)
jump %ENTRY_CODE(Sp(SP_OFF));
} else {
/* Did not commit: re-execute */
#if defined(PROFILING)
W_ unused1, W_ unused2,
#endif
- "ptr" W_ unused3, "ptr" W_ unused4)
+ P_ unused3, P_ unused4)
{
W_ frame, trec, valid, next_invariant, q, outer;
- IF_NOT_REG_R1(W_ rval; rval = Sp(0); Sp_adj(1); )
frame = Sp;
trec = StgTSO_trec(CurrentTSO);
/* Transaction was valid: commit succeeded */
StgTSO_trec(CurrentTSO) = NO_TREC;
Sp = Sp + SIZEOF_StgAtomicallyFrame;
- IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;)
jump %ENTRY_CODE(Sp(SP_OFF));
} else {
/* Transaction was not valid: try again */
#if defined(PROFILING)
W_ unused1, W_ unused2,
#endif
- "ptr" W_ unused3, "ptr" W_ unused4)
+ P_ unused3, P_ unused4)
{
W_ frame, trec, valid;
- IF_NOT_REG_R1(W_ rval; rval = Sp(0); Sp_adj(1); )
frame = Sp;
(valid) = foreign "C" stmReWait(MyCapability() "ptr", CurrentTSO "ptr") [];
if (valid != 0) {
/* Previous attempt is still valid: no point trying again yet */
- IF_NOT_REG_R1(Sp_adj(-2);
- Sp(1) = stg_NO_FINALIZER_closure;
- Sp(0) = stg_ut_1_0_unreg_info;)
jump stg_block_noregs;
} else {
/* Previous attempt is no longer valid: try again */
// STM catch frame --------------------------------------------------------------
-#ifdef REG_R1
#define SP_OFF 0
-#else
-#define SP_OFF 1
-#endif
/* Catch frames are very similar to update frames, but when entering
* one we just pop the frame off the stack and perform the correct
#if defined(PROFILING)
W_ unused1, W_ unused2,
#endif
- "ptr" W_ unused3, "ptr" W_ unused4)
+ P_ unused3, P_ unused4)
{
- IF_NOT_REG_R1(W_ rval; rval = Sp(0); Sp_adj(1); )
W_ r, frame, trec, outer;
frame = Sp;
trec = StgTSO_trec(CurrentTSO);
/* Commit succeeded */
StgTSO_trec(CurrentTSO) = outer;
Sp = Sp + SIZEOF_StgCatchSTMFrame;
- IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;)
jump Sp(SP_OFF);
} else {
/* Commit failed */
/* Nested transactions are not allowed; raise an exception */
if (old_trec != NO_TREC) {
- R1 = base_GHCziIOBase_NestedAtomically_closure;
+ R1 = base_ControlziExceptionziBase_nestedAtomically_closure;
jump raisezh_fast;
}
StgHeader_info(frame) = stg_atomically_waiting_frame_info;
Sp = frame;
// Fix up the stack in the unregisterised case: the return convention is different.
- IF_NOT_REG_R1(Sp_adj(-2);
- Sp(1) = stg_NO_FINALIZER_closure;
- Sp(0) = stg_ut_1_0_unreg_info;)
R3 = trec; // passing to stmWaitUnblock()
jump stg_block_stmwait;
} else {
RET_P(result);
}
+readTVarIOzh_fast
+{
+ W_ result;
+
+again:
+ result = StgTVar_current_value(R1);
+ if (%INFO_PTR(result) == stg_TREC_HEADER_info) {
+ goto again;
+ }
+ RET_P(result);
+}
writeTVarzh_fast
{
{
/* args: R1 = MVar closure */
- if (GET_INFO(R1) == stg_EMPTY_MVAR_info) {
+ if (StgMVar_value(R1) == stg_END_TSO_QUEUE_closure) {
RET_N(1);
} else {
RET_N(0);
ALLOC_PRIM ( SIZEOF_StgMVar, NO_PTRS, newMVarzh_fast );
mvar = Hp - SIZEOF_StgMVar + WDS(1);
- SET_HDR(mvar,stg_EMPTY_MVAR_info,W_[CCCS]);
+ SET_HDR(mvar,stg_MVAR_DIRTY_info,W_[CCCS]);
+ // MVARs start dirty: generation 0 has no mutable list
StgMVar_head(mvar) = stg_END_TSO_QUEUE_closure;
StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
}
-/* If R1 isn't available, pass it on the stack */
-#ifdef REG_R1
#define PerformTake(tso, value) \
W_[StgTSO_sp(tso) + WDS(1)] = value; \
W_[StgTSO_sp(tso) + WDS(0)] = stg_gc_unpt_r1_info;
-#else
-#define PerformTake(tso, value) \
- W_[StgTSO_sp(tso) + WDS(1)] = value; \
- W_[StgTSO_sp(tso) + WDS(0)] = stg_ut_1_0_unreg_info;
-#endif
#define PerformPut(tso,lval) \
StgTSO_sp(tso) = StgTSO_sp(tso) + WDS(3); \
#else
info = GET_INFO(mvar);
#endif
+
+ if (info == stg_MVAR_CLEAN_info) {
+ foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr") [];
+ }
/* If the MVar is empty, put ourselves on its blocking queue,
* and wait until we're woken up.
*/
- if (info == stg_EMPTY_MVAR_info) {
+ if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
StgMVar_head(mvar) = CurrentTSO;
} else {
- StgTSO_link(StgMVar_tail(mvar)) = CurrentTSO;
+ foreign "C" setTSOLink(MyCapability() "ptr",
+ StgMVar_tail(mvar) "ptr",
+ CurrentTSO) [];
}
- StgTSO_link(CurrentTSO) = stg_END_TSO_QUEUE_closure;
+ StgTSO__link(CurrentTSO) = stg_END_TSO_QUEUE_closure;
StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
StgTSO_block_info(CurrentTSO) = mvar;
StgMVar_tail(mvar) = CurrentTSO;
+ R1 = mvar;
jump stg_block_takemvar;
}
/* actually perform the putMVar for the thread that we just woke up */
tso = StgMVar_head(mvar);
PerformPut(tso,StgMVar_value(mvar));
- dirtyTSO(tso);
-#if defined(GRAN) || defined(PAR)
- /* ToDo: check 2nd arg (mvar) is right */
- ("ptr" tso) = foreign "C" unblockOne(StgMVar_head(mvar),mvar) [];
- StgMVar_head(mvar) = tso;
-#else
- ("ptr" tso) = foreign "C" unblockOne(MyCapability() "ptr",
- StgMVar_head(mvar) "ptr") [];
+ if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 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;
-#endif
if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
}
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_FULL_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
+#else
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
RET_P(val);
}
StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_EMPTY_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
#else
- SET_INFO(mvar,stg_EMPTY_MVAR_info);
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
RET_P(val);
info = GET_INFO(mvar);
#endif
- if (info == stg_EMPTY_MVAR_info) {
+ if (StgMVar_value(mvar) == stg_END_TSO_QUEUE_closure) {
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_EMPTY_MVAR_info);
+ unlockClosure(mvar, info);
#endif
/* HACK: we need a pointer to pass back,
* so we abuse NO_FINALIZER_closure
RET_NP(0, stg_NO_FINALIZER_closure);
}
+ if (info == stg_MVAR_CLEAN_info) {
+ foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr");
+ }
+
/* we got the value... */
val = StgMVar_value(mvar);
/* actually perform the putMVar for the thread that we just woke up */
tso = StgMVar_head(mvar);
PerformPut(tso,StgMVar_value(mvar));
- dirtyTSO(tso);
+ if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+ foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
+ }
-#if defined(GRAN) || defined(PAR)
- /* ToDo: check 2nd arg (mvar) is right */
- ("ptr" tso) = foreign "C" unblockOne(StgMVar_head(mvar) "ptr", mvar "ptr") [];
+ ("ptr" tso) = foreign "C" unblockOne_(MyCapability() "ptr",
+ StgMVar_head(mvar) "ptr", 1) [];
StgMVar_head(mvar) = tso;
-#else
- ("ptr" tso) = foreign "C" unblockOne(MyCapability() "ptr",
- StgMVar_head(mvar) "ptr") [];
- StgMVar_head(mvar) = tso;
-#endif
if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
}
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_FULL_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
+#else
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
}
else
/* No further putMVars, MVar is now empty */
StgMVar_value(mvar) = stg_END_TSO_QUEUE_closure;
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_EMPTY_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
#else
- SET_INFO(mvar,stg_EMPTY_MVAR_info);
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
}
putMVarzh_fast
{
- W_ mvar, info, tso;
+ W_ mvar, val, info, tso;
/* 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_FULL_MVAR_info) {
+ if (info == stg_MVAR_CLEAN_info) {
+ foreign "C" dirty_MVAR(BaseReg "ptr", mvar "ptr");
+ }
+
+ if (StgMVar_value(mvar) != stg_END_TSO_QUEUE_closure) {
if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
StgMVar_head(mvar) = CurrentTSO;
} else {
- StgTSO_link(StgMVar_tail(mvar)) = CurrentTSO;
+ foreign "C" setTSOLink(MyCapability() "ptr",
+ StgMVar_tail(mvar) "ptr",
+ CurrentTSO) [];
}
- StgTSO_link(CurrentTSO) = stg_END_TSO_QUEUE_closure;
+ StgTSO__link(CurrentTSO) = stg_END_TSO_QUEUE_closure;
StgTSO_why_blocked(CurrentTSO) = BlockedOnMVar::I16;
StgTSO_block_info(CurrentTSO) = mvar;
StgMVar_tail(mvar) = CurrentTSO;
+ R1 = mvar;
+ R2 = val;
jump stg_block_putmvar;
}
/* actually perform the takeMVar */
tso = StgMVar_head(mvar);
- PerformTake(tso, R2);
- dirtyTSO(tso);
+ PerformTake(tso, val);
+ if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+ foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
+ }
-#if defined(GRAN) || defined(PAR)
- /* ToDo: check 2nd arg (mvar) is right */
- ("ptr" tso) = foreign "C" unblockOne(MyCapability() "ptr", StgMVar_head(mvar) "ptr",mvar "ptr") [];
- StgMVar_head(mvar) = tso;
-#else
- ("ptr" tso) = foreign "C" unblockOne(MyCapability() "ptr", StgMVar_head(mvar) "ptr") [];
+ ("ptr" tso) = foreign "C" unblockOne_(MyCapability() "ptr",
+ StgMVar_head(mvar) "ptr", 1) [];
StgMVar_head(mvar) = tso;
-#endif
if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
}
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_EMPTY_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
+#else
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
jump %ENTRY_CODE(Sp(0));
}
else
{
/* No further takes, the MVar is now full. */
- StgMVar_value(mvar) = R2;
+ StgMVar_value(mvar) = val;
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_FULL_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
#else
- SET_INFO(mvar,stg_FULL_MVAR_info);
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
jump %ENTRY_CODE(Sp(0));
}
info = GET_INFO(mvar);
#endif
- if (info == stg_FULL_MVAR_info) {
+ if (StgMVar_value(mvar) != stg_END_TSO_QUEUE_closure) {
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_FULL_MVAR_info);
+ unlockClosure(mvar, info);
#endif
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
/* actually perform the takeMVar */
tso = StgMVar_head(mvar);
PerformTake(tso, R2);
- dirtyTSO(tso);
+ if (TO_W_(StgTSO_flags(tso)) & TSO_DIRTY == 0) {
+ foreign "C" dirty_TSO(MyCapability() "ptr", tso "ptr") [];
+ }
-#if defined(GRAN) || defined(PAR)
- /* ToDo: check 2nd arg (mvar) is right */
- ("ptr" tso) = foreign "C" unblockOne(MyCapability() "ptr", StgMVar_head(mvar) "ptr",mvar "ptr") [];
- StgMVar_head(mvar) = tso;
-#else
- ("ptr" tso) = foreign "C" unblockOne(MyCapability() "ptr", StgMVar_head(mvar) "ptr") [];
+ ("ptr" tso) = foreign "C" unblockOne_(MyCapability() "ptr",
+ StgMVar_head(mvar) "ptr", 1) [];
StgMVar_head(mvar) = tso;
-#endif
if (StgMVar_head(mvar) == stg_END_TSO_QUEUE_closure) {
StgMVar_tail(mvar) = stg_END_TSO_QUEUE_closure;
}
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_EMPTY_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
+#else
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
}
else
StgMVar_value(mvar) = R2;
#if defined(THREADED_RTS)
- unlockClosure(mvar, stg_FULL_MVAR_info);
+ unlockClosure(mvar, stg_MVAR_DIRTY_info);
#else
- SET_INFO(mvar,stg_FULL_MVAR_info);
+ SET_INFO(mvar,stg_MVAR_DIRTY_info);
#endif
}
* macro in Schedule.h).
*/
#define APPEND_TO_BLOCKED_QUEUE(tso) \
- ASSERT(StgTSO_link(tso) == END_TSO_QUEUE); \
+ ASSERT(StgTSO__link(tso) == END_TSO_QUEUE); \
if (W_[blocked_queue_hd] == END_TSO_QUEUE) { \
W_[blocked_queue_hd] = tso; \
} else { \
- StgTSO_link(W_[blocked_queue_tl]) = tso; \
+ foreign "C" setTSOLink(MyCapability() "ptr", W_[blocked_queue_tl] "ptr", tso) []; \
} \
W_[blocked_queue_tl] = tso;
W_ time;
W_ divisor;
(time) = foreign "C" getourtimeofday() [R1];
- divisor = TO_W_(RtsFlags_MiscFlags_tickInterval(RtsFlags))*1000;
+ divisor = TO_W_(RtsFlags_MiscFlags_tickInterval(RtsFlags));
+ if (divisor == 0) {
+ divisor = 50;
+ }
+ divisor = divisor * 1000;
target = ((R1 + divisor - 1) / divisor) /* divide rounding up */
+ time + 1; /* Add 1 as getourtimeofday rounds down */
StgTSO_block_info(CurrentTSO) = target;
while:
if (t != END_TSO_QUEUE && StgTSO_block_info(t) < target) {
prev = t;
- t = StgTSO_link(t);
+ t = StgTSO__link(t);
goto while;
}
- StgTSO_link(CurrentTSO) = t;
+ StgTSO__link(CurrentTSO) = t;
if (prev == NULL) {
W_[sleeping_queue] = CurrentTSO;
} else {
- StgTSO_link(prev) = CurrentTSO;
+ foreign "C" setTSOLink(MyCapability() "ptr", prev "ptr", CurrentTSO) [];
}
jump stg_block_noregs;
#endif
}
RET_NP(ok,val);
}
+
+getSparkzh_fast
+{
+ W_ spark;
+
+#ifndef THREADED_RTS
+ RET_NP(0,ghczmprim_GHCziBool_False_closure);
+#else
+ (spark) = foreign "C" findSpark(MyCapability());
+ if (spark != 0) {
+ RET_NP(1,spark);
+ } else {
+ RET_NP(0,ghczmprim_GHCziBool_False_closure);
+ }
+#endif
+}