#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_GHCziIOBase_NestedAtomically_closure;
import EnterCriticalSection;
import LeaveCriticalSection;
-#endif
/*-----------------------------------------------------------------------------
Array Primitives
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
("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
{
/* 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;
#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;
/* 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") [];
- 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_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
}
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;
/* 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
jump %ENTRY_CODE(Sp(0));
}
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
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
projects / ghc-hetmet.git / blobdiff