#define GMP_TAKE2_RET1(name,mp_fun) \
name \
{ \
- W_ s1, s2, d1, d2; \
+ CInt s1, s2; \
+ W_ d1, d2; \
\
/* call doYouWantToGC() */ \
MAYBE_GC(R2_PTR & R4_PTR, name); \
\
- s1 = R1; \
+ s1 = W_TO_INT(R1); \
d1 = R2; \
- s2 = R3; \
+ s2 = W_TO_INT(R3); \
d2 = R4; \
\
- MP_INT__mp_alloc(mp_tmp1) = StgArrWords_words(d1); \
+ MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1)); \
MP_INT__mp_size(mp_tmp1) = (s1); \
MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(d1); \
- MP_INT__mp_alloc(mp_tmp2) = StgArrWords_words(d2); \
+ MP_INT__mp_alloc(mp_tmp2) = W_TO_INT(StgArrWords_words(d2)); \
MP_INT__mp_size(mp_tmp2) = (s2); \
MP_INT__mp_d(mp_tmp2) = BYTE_ARR_CTS(d2); \
\
/* Perform the operation */ \
foreign "C" mp_fun(result1,mp_tmp1,mp_tmp2); \
\
- RET_NP(MP_INT__mp_size(result1), \
+ RET_NP(TO_W_(MP_INT__mp_size(result1)), \
MP_INT__mp_d(result1) - SIZEOF_StgArrWords); \
}
#define GMP_TAKE1_RET1(name,mp_fun) \
name \
{ \
- W_ s1, d1; \
+ CInt s1; \
+ W_ d1; \
\
/* call doYouWantToGC() */ \
MAYBE_GC(R2_PTR, name); \
\
d1 = R2; \
- s1 = R1; \
+ s1 = W_TO_INT(R1); \
\
- MP_INT__mp_alloc(mp_tmp1) = StgArrWords_words(d1); \
+ MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1)); \
MP_INT__mp_size(mp_tmp1) = (s1); \
MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(d1); \
\
/* Perform the operation */ \
foreign "C" mp_fun(result1,mp_tmp1); \
\
- RET_NP(MP_INT__mp_size(result1), \
+ RET_NP(TO_W_(MP_INT__mp_size(result1)), \
MP_INT__mp_d(result1) - SIZEOF_StgArrWords); \
}
#define GMP_TAKE2_RET2(name,mp_fun) \
name \
{ \
- W_ s1, s2, d1, d2; \
+ CInt s1, s2; \
+ W_ d1, d2; \
\
/* call doYouWantToGC() */ \
MAYBE_GC(R2_PTR & R4_PTR, name); \
\
- s1 = R1; \
+ s1 = W_TO_INT(R1); \
d1 = R2; \
- s2 = R3; \
+ s2 = W_TO_INT(R3); \
d2 = R4; \
\
- MP_INT__mp_alloc(mp_tmp1) = StgArrWords_words(d1); \
+ MP_INT__mp_alloc(mp_tmp1) = W_TO_INT(StgArrWords_words(d1)); \
MP_INT__mp_size(mp_tmp1) = (s1); \
MP_INT__mp_d(mp_tmp1) = BYTE_ARR_CTS(d1); \
- MP_INT__mp_alloc(mp_tmp2) = StgArrWords_words(d2); \
+ MP_INT__mp_alloc(mp_tmp2) = W_TO_INT(StgArrWords_words(d2)); \
MP_INT__mp_size(mp_tmp2) = (s2); \
MP_INT__mp_d(mp_tmp2) = BYTE_ARR_CTS(d2); \
\
/* Perform the operation */ \
foreign "C" mp_fun(result1,result2,mp_tmp1,mp_tmp2); \
\
- RET_NPNP(MP_INT__mp_size(result1), \
+ RET_NPNP(TO_W_(MP_INT__mp_size(result1)), \
MP_INT__mp_d(result1) - SIZEOF_StgArrWords, \
- MP_INT__mp_size(result2), \
+ TO_W_(MP_INT__mp_size(result2)), \
MP_INT__mp_d(result2) - SIZEOF_StgArrWords); \
}
cmp = foreign "C" mpn_cmp(up "ptr", vp "ptr", size);
- if (cmp == 0) {
+ if (cmp == 0 :: CInt) {
R1 = 0;
jump %ENTRY_CODE(Sp(0));
}
- if (%lt(cmp,0) == %lt(usize,0)) {
+ if (%lt(cmp,0 :: CInt) == %lt(usize,0)) {
R1 = 1;
} else {
R1 = (-1);
foreign "C" __decodeFloat(mp_tmp1,exponent,arg);
/* returns: (Int# (expn), Int#, ByteArray#) */
- RET_NNP(W_[exponent], MP_INT__mp_size(mp_tmp1), p);
+ RET_NNP(W_[exponent], TO_W_(MP_INT__mp_size(mp_tmp1)), p);
}
#define DOUBLE_MANTISSA_SIZE SIZEOF_DOUBLE
foreign "C" __decodeDouble(mp_tmp1,exponent,arg);
/* returns: (Int# (expn), Int#, ByteArray#) */
- RET_NNP(W_[exponent], MP_INT__mp_size(mp_tmp1), p);
+ RET_NNP(W_[exponent], TO_W_(MP_INT__mp_size(mp_tmp1)), p);
}
/* -----------------------------------------------------------------------------
foreign "C" scheduleThread(R1 "ptr");
// switch at the earliest opportunity
- CInt[context_switch] = 1;
+ CInt[context_switch] = 1 :: CInt;
RET_P(R1);
}
RET_N(r);
}
+
+/* -----------------------------------------------------------------------------
+ * 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 ------------------------------------------------------------
+
+#define CATCH_RETRY_FRAME_ERROR(label) \
+ label { foreign "C" barf("catch_retry_frame incorrectly entered!"); }
+
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_0_ret)
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_1_ret)
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_2_ret)
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_3_ret)
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_4_ret)
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_5_ret)
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_6_ret)
+CATCH_RETRY_FRAME_ERROR(stg_catch_retry_frame_7_ret)
+
+#if MAX_VECTORED_RTN > 8
+#error MAX_VECTORED_RTN has changed: please modify stg_catch_retry_frame too.
+#endif
+
+#if defined(PROFILING)
+#define CATCH_RETRY_FRAME_BITMAP 7
+#define CATCH_RETRY_FRAME_WORDS 6
+#else
+#define CATCH_RETRY_FRAME_BITMAP 1
+#define CATCH_RETRY_FRAME_WORDS 4
+#endif
+
+INFO_TABLE_RET(stg_catch_retry_frame,
+ CATCH_RETRY_FRAME_WORDS, CATCH_RETRY_FRAME_BITMAP,
+ CATCH_RETRY_FRAME,
+ stg_catch_retry_frame_0_ret,
+ stg_catch_retry_frame_1_ret,
+ stg_catch_retry_frame_2_ret,
+ stg_catch_retry_frame_3_ret,
+ stg_catch_retry_frame_4_ret,
+ stg_catch_retry_frame_5_ret,
+ stg_catch_retry_frame_6_ret,
+ stg_catch_retry_frame_7_ret)
+{
+ W_ r, frame, trec, outer;
+ IF_NOT_REG_R1(W_ rval; rval = Sp(0); Sp_adj(1); )
+
+ frame = Sp;
+ trec = StgTSO_trec(CurrentTSO);
+ "ptr" outer = foreign "C" stmGetEnclosingTRec(trec "ptr");
+ r = foreign "C" stmCommitTransaction(trec "ptr");
+ if (r) {
+ /* 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: retry */
+ W_ new_trec;
+ "ptr" new_trec = foreign "C" stmStartTransaction(outer "ptr");
+ StgTSO_trec(CurrentTSO) = new_trec;
+ if (StgCatchRetryFrame_running_alt_code(frame)) {
+ R1 = StgCatchRetryFrame_alt_code(frame);
+ } else {
+ R1 = StgCatchRetryFrame_first_code(frame);
+ StgCatchRetryFrame_first_code_trec(frame) = new_trec;
+ }
+ Sp_adj(-1);
+ jump RET_LBL(stg_ap_v);
+ }
+}
+
+
+// Atomically frame -------------------------------------------------------------
+
+
+#define ATOMICALLY_FRAME_ERROR(label) \
+ label { foreign "C" barf("atomically_frame incorrectly entered!"); }
+
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_0_ret)
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_1_ret)
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_2_ret)
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_3_ret)
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_4_ret)
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_5_ret)
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_6_ret)
+ATOMICALLY_FRAME_ERROR(stg_atomically_frame_7_ret)
+
+#if MAX_VECTORED_RTN > 8
+#error MAX_VECTORED_RTN has changed: please modify stg_atomically_frame too.
+#endif
+
+#if defined(PROFILING)
+#define ATOMICALLY_FRAME_BITMAP 7
+#define ATOMICALLY_FRAME_WORDS 4
+#else
+#define ATOMICALLY_FRAME_BITMAP 1
+#define ATOMICALLY_FRAME_WORDS 2
+#endif
+
+
+INFO_TABLE_RET(stg_atomically_frame,
+ ATOMICALLY_FRAME_WORDS, ATOMICALLY_FRAME_BITMAP,
+ ATOMICALLY_FRAME,
+ stg_atomically_frame_0_ret,
+ stg_atomically_frame_1_ret,
+ stg_atomically_frame_2_ret,
+ stg_atomically_frame_3_ret,
+ stg_atomically_frame_4_ret,
+ stg_atomically_frame_5_ret,
+ stg_atomically_frame_6_ret,
+ stg_atomically_frame_7_ret)
+{
+ W_ frame, trec, valid;
+ IF_NOT_REG_R1(W_ rval; rval = Sp(0); Sp_adj(1); )
+
+ frame = Sp;
+ trec = StgTSO_trec(CurrentTSO);
+ if (StgAtomicallyFrame_waiting(frame)) {
+ /* The TSO is currently waiting: should we stop waiting? */
+ valid = foreign "C" stmReWait(CurrentTSO "ptr");
+ if (valid) {
+ /* 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 */
+ "ptr" trec = foreign "C" stmStartTransaction(NO_TREC "ptr");
+ StgTSO_trec(CurrentTSO) = trec;
+ StgAtomicallyFrame_waiting(frame) = 0 :: CInt; /* false; */
+ R1 = StgAtomicallyFrame_code(frame);
+ Sp_adj(-1);
+ jump RET_LBL(stg_ap_v);
+ }
+ } else {
+ /* The TSO is not currently waiting: try to commit the transaction */
+ valid = foreign "C" stmCommitTransaction(trec "ptr");
+ if (valid) {
+ /* 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 */
+ "ptr" trec = foreign "C" stmStartTransaction(NO_TREC "ptr");
+ StgTSO_trec(CurrentTSO) = trec;
+ R1 = StgAtomicallyFrame_code(frame);
+ Sp_adj(-1);
+ jump RET_LBL(stg_ap_v);
+ }
+ }
+}
+
+
+// STM catch frame --------------------------------------------------------------
+
+#define CATCH_STM_FRAME_ENTRY_TEMPLATE(label,ret) \
+ label \
+ { \
+ IF_NOT_REG_R1(W_ rval; rval = Sp(0); Sp_adj(1); ) \
+ Sp = Sp + SIZEOF_StgCatchSTMFrame; \
+ IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;) \
+ jump ret; \
+ }
+
+#ifdef REG_R1
+#define SP_OFF 0
+#else
+#define SP_OFF 1
+#endif
+
+CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_0_ret,%RET_VEC(Sp(SP_OFF),0))
+CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_1_ret,%RET_VEC(Sp(SP_OFF),1))
+CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_2_ret,%RET_VEC(Sp(SP_OFF),2))
+CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_3_ret,%RET_VEC(Sp(SP_OFF),3))
+CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_4_ret,%RET_VEC(Sp(SP_OFF),4))
+CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_5_ret,%RET_VEC(Sp(SP_OFF),5))
+CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_6_ret,%RET_VEC(Sp(SP_OFF),6))
+CATCH_STM_FRAME_ENTRY_TEMPLATE(stg_catch_stm_frame_7_ret,%RET_VEC(Sp(SP_OFF),7))
+
+#if MAX_VECTORED_RTN > 8
+#error MAX_VECTORED_RTN has changed: please modify stg_catch_stm_frame too.
+#endif
+
+#if defined(PROFILING)
+#define CATCH_STM_FRAME_BITMAP 3
+#define CATCH_STM_FRAME_WORDS 3
+#else
+#define CATCH_STM_FRAME_BITMAP 0
+#define CATCH_STM_FRAME_WORDS 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
+ * kind of return to the activation record underneath us on the stack.
+ */
+
+INFO_TABLE_RET(stg_catch_stm_frame,
+ CATCH_STM_FRAME_WORDS, CATCH_STM_FRAME_BITMAP,
+ CATCH_STM_FRAME,
+ stg_catch_stm_frame_0_ret,
+ stg_catch_stm_frame_1_ret,
+ stg_catch_stm_frame_2_ret,
+ stg_catch_stm_frame_3_ret,
+ stg_catch_stm_frame_4_ret,
+ stg_catch_stm_frame_5_ret,
+ stg_catch_stm_frame_6_ret,
+ stg_catch_stm_frame_7_ret)
+CATCH_STM_FRAME_ENTRY_TEMPLATE(,%ENTRY_CODE(Sp(SP_OFF)))
+
+
+// Primop definition ------------------------------------------------------------
+
+atomicallyzh_fast
+{
+ W_ frame;
+ W_ old_trec;
+ W_ new_trec;
+
+ /* Args: R1 = m :: STM a */
+ STK_CHK_GEN(SIZEOF_StgAtomicallyFrame + WDS(1), R1_PTR, atomicallyzh_fast);
+
+ /* Set up the atomically frame */
+ Sp = Sp - SIZEOF_StgAtomicallyFrame;
+ frame = Sp;
+
+ SET_HDR(frame,stg_atomically_frame_info,CCCS);
+ StgAtomicallyFrame_waiting(frame) = 0 :: CInt; // False
+ StgAtomicallyFrame_code(frame) = R1;
+
+ /* Start the memory transcation */
+ old_trec = StgTSO_trec(CurrentTSO);
+ "ptr" new_trec = foreign "C" stmStartTransaction(old_trec "ptr");
+ StgTSO_trec(CurrentTSO) = new_trec;
+
+ /* Apply R1 to the realworld token */
+ Sp_adj(-1);
+ jump RET_LBL(stg_ap_v);
+}
+
+
+catchSTMzh_fast
+{
+ W_ frame;
+
+ /* Args: R1 :: STM a */
+ /* Args: R2 :: Exception -> STM a */
+ STK_CHK_GEN(SIZEOF_StgCatchSTMFrame + WDS(1), R1_PTR & R2_PTR, catchSTMzh_fast);
+
+ /* Set up the catch frame */
+ Sp = Sp - SIZEOF_StgCatchSTMFrame;
+ frame = Sp;
+
+ SET_HDR(frame, stg_catch_stm_frame_info, CCCS);
+ StgCatchSTMFrame_handler(frame) = R2;
+
+ /* Apply R1 to the realworld token */
+ Sp_adj(-1);
+ jump RET_LBL(stg_ap_v);
+}
+
+
+catchRetryzh_fast
+{
+ W_ frame;
+ W_ new_trec;
+ W_ trec;
+
+ /* Args: R1 :: STM a */
+ /* Args: R2 :: STM a */
+ STK_CHK_GEN(SIZEOF_StgCatchRetryFrame + WDS(1), R1_PTR & R2_PTR, catchRetryzh_fast);
+
+ /* Start a nested transaction within which to run the first code */
+ trec = StgTSO_trec(CurrentTSO);
+ "ptr" new_trec = foreign "C" stmStartTransaction(trec "ptr");
+ StgTSO_trec(CurrentTSO) = new_trec;
+
+ /* Set up the catch-retry frame */
+ Sp = Sp - SIZEOF_StgCatchRetryFrame;
+ frame = Sp;
+
+ SET_HDR(frame, stg_catch_retry_frame_info, CCCS);
+ StgCatchRetryFrame_running_alt_code(frame) = 0 :: CInt; // false;
+ StgCatchRetryFrame_first_code(frame) = R1;
+ StgCatchRetryFrame_alt_code(frame) = R2;
+ StgCatchRetryFrame_first_code_trec(frame) = new_trec;
+
+ /* Apply R1 to the realworld token */
+ Sp_adj(-1);
+ jump RET_LBL(stg_ap_v);
+}
+
+
+retryzh_fast
+{
+ W_ frame_type;
+ W_ frame;
+ W_ trec;
+ W_ outer;
+ W_ r;
+
+ MAYBE_GC (NO_PTRS, retryzh_fast); // STM operations may allocate
+
+ // Find the enclosing ATOMICALLY_FRAME or CATCH_RETRY_FRAME
+retry_pop_stack:
+ trec = StgTSO_trec(CurrentTSO);
+ "ptr" outer = foreign "C" stmGetEnclosingTRec(trec "ptr");
+ StgTSO_sp(CurrentTSO) = Sp;
+ frame_type = foreign "C" findRetryFrameHelper(CurrentTSO "ptr");
+ Sp = StgTSO_sp(CurrentTSO);
+ frame = Sp;
+
+ if (frame_type == CATCH_RETRY_FRAME) {
+ // The retry reaches a CATCH_RETRY_FRAME before the atomic frame
+ ASSERT(outer != NO_TREC);
+ if (!StgCatchRetryFrame_running_alt_code(frame)) {
+ // Retry in the first code: try the alternative
+ "ptr" trec = foreign "C" stmStartTransaction(outer "ptr");
+ StgTSO_trec(CurrentTSO) = trec;
+ StgCatchRetryFrame_running_alt_code(frame) = 1 :: CInt; // true;
+ R1 = StgCatchRetryFrame_alt_code(frame);
+ Sp_adj(-1);
+ jump RET_LBL(stg_ap_v);
+ } else {
+ // Retry in the alternative code: propagate
+ W_ other_trec;
+ other_trec = StgCatchRetryFrame_first_code_trec(frame);
+ r = foreign "C" stmMergeForWaiting(trec "ptr", other_trec "ptr");
+ if (r) {
+ r = foreign "C" stmCommitTransaction(trec "ptr");
+ }
+ if (r) {
+ // Merge between siblings succeeded: commit it back to enclosing transaction
+ // and then propagate the retry
+ StgTSO_trec(CurrentTSO) = outer;
+ Sp = Sp + SIZEOF_StgCatchRetryFrame;
+ goto retry_pop_stack;
+ } else {
+ // Merge failed: we musn't propagate the retry. Try both paths again.
+ "ptr" trec = foreign "C" stmStartTransaction(outer "ptr");
+ StgCatchRetryFrame_first_code_trec(frame) = trec;
+ StgCatchRetryFrame_running_alt_code(frame) = 0 :: CInt; // false;
+ StgTSO_trec(CurrentTSO) = trec;
+ R1 = StgCatchRetryFrame_first_code(frame);
+ Sp_adj(-1);
+ jump RET_LBL(stg_ap_v);
+ }
+ }
+ }
+
+ // We've reached the ATOMICALLY_FRAME: attempt to wait
+ ASSERT(frame_type == ATOMICALLY_FRAME);
+ ASSERT(outer == NO_TREC);
+ r = foreign "C" stmWait(CurrentTSO "ptr", trec "ptr");
+ if (r) {
+ // Transaction was valid: stmWait put us on the TVars' queues, we now block
+ StgAtomicallyFrame_waiting(frame) = 1 :: CInt; // true
+ 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;)
+ jump stg_block_noregs;
+ } else {
+ // Transaction was not valid: retry immediately
+ "ptr" trec = foreign "C" stmStartTransaction(outer "ptr");
+ StgTSO_trec(CurrentTSO) = trec;
+ R1 = StgAtomicallyFrame_code(frame);
+ Sp = frame;
+ Sp_adj(-1);
+ jump RET_LBL(stg_ap_v);
+ }
+}
+
+
+newTVarzh_fast
+{
+ W_ tv;
+
+ /* Args: R1 = initialisation value */
+
+ ALLOC_PRIM( SIZEOF_StgTVar, R1_PTR, newTVarzh_fast);
+ tv = Hp - SIZEOF_StgTVar + WDS(1);
+ SET_HDR(tv,stg_TVAR_info,W_[CCCS]);
+ StgTVar_current_value(tv) = R1;
+ StgTVar_first_wait_queue_entry(tv) = stg_END_STM_WAIT_QUEUE_closure;
+
+ RET_P(tv);
+}
+
+
+readTVarzh_fast
+{
+ W_ trec;
+ W_ tvar;
+ W_ result;
+
+ /* Args: R1 = TVar closure */
+
+ MAYBE_GC (R1_PTR, readTVarzh_fast); // Call to stmReadTVar may allocate
+ trec = StgTSO_trec(CurrentTSO);
+ tvar = R1;
+ "ptr" result = foreign "C" stmReadTVar(trec "ptr", tvar "ptr");
+
+ RET_P(result);
+}
+
+
+writeTVarzh_fast
+{
+ W_ trec;
+ W_ tvar;
+ W_ new_value;
+
+ /* Args: R1 = TVar closure */
+ /* R2 = New value */
+
+ MAYBE_GC (R1_PTR & R2_PTR, writeTVarzh_fast); // Call to stmWriteTVar may allocate
+ trec = StgTSO_trec(CurrentTSO);
+ tvar = R1;
+ new_value = R2;
+ foreign "C" stmWriteTVar(trec "ptr", tvar "ptr", new_value "ptr");
+
+ jump %ENTRY_CODE(Sp(0));
+}
+
+
/* -----------------------------------------------------------------------------
* MVar primitives
*
// This function is *only* used to wrap zero-arity BCOs in an
// updatable wrapper (see ByteCodeLink.lhs). An AP thunk is always
// saturated and always points directly to a FUN or BCO.
- ASSERT(%INFO_TYPE(%GET_STD_INFO(R1)) == BCO::I16 &&
- StgBCO_arity(R1) == 0::I16);
+ ASSERT(%INFO_TYPE(%GET_STD_INFO(R1)) == HALF_W_(BCO) &&
+ StgBCO_arity(R1) == HALF_W_(0));
HP_CHK_GEN_TICKY(SIZEOF_StgAP, R1_PTR, mkApUpd0zh_fast);
TICK_ALLOC_UP_THK(0, 0);
ap = Hp - SIZEOF_StgAP + WDS(1);
SET_HDR(ap, stg_AP_info, W_[CCCS]);
- StgAP_n_args(ap) = 0::I16;
+ StgAP_n_args(ap) = HALF_W_(0);
StgAP_fun(ap) = R1;
RET_P(ap);
STRING(stg_delayzh_malloc_str, "delayzh_fast")
delayzh_fast
{
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
W_ ares;
CInt reqID;
#else
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
StgTSO_why_blocked(CurrentTSO) = BlockedOnDelay::I16;
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
/* could probably allocate this on the heap instead */
"ptr" ares = foreign "C" stgMallocBytes(SIZEOF_StgAsyncIOResult,
*/
StgTSO_why_blocked(CurrentTSO) = BlockedOnDoProc::I16;
APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
+ jump stg_block_async_void;
#else
- CInt time;
+ W_ time;
time = foreign "C" getourtimeofday();
- target = (R1 / (TICK_MILLISECS*1000)) + TO_W_(time);
+ target = (R1 / (TICK_MILLISECS*1000)) + time;
StgTSO_block_info(CurrentTSO) = target;
/* Insert the new thread in the sleeping queue. */
} else {
StgTSO_link(prev) = CurrentTSO;
}
-#endif
-
jump stg_block_noregs;
+#endif
}
-#ifdef mingw32_TARGET_OS
+#ifdef mingw32_HOST_OS
STRING(stg_asyncReadzh_malloc_str, "asyncReadzh_fast")
asyncReadzh_fast
{
projects / ghc-hetmet.git / blobdiff