LDV_RECORD_CREATE(w);
f = StgWeak_finalizer(w);
+ StgDeadWeak_link(w) = StgWeak_link(w);
/* return the finalizer */
if (f == stg_NO_FINALIZER_closure) {
#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_ENTRY_TEMPLATE(label,ret) \
+ label \
+ { \
+ 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 ret; \
+ } 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); \
+ } \
+ }
+
+CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_0_ret,%RET_VEC(Sp(SP_OFF),0))
+CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_1_ret,%RET_VEC(Sp(SP_OFF),1))
+CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_2_ret,%RET_VEC(Sp(SP_OFF),2))
+CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_3_ret,%RET_VEC(Sp(SP_OFF),3))
+CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_4_ret,%RET_VEC(Sp(SP_OFF),4))
+CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_5_ret,%RET_VEC(Sp(SP_OFF),5))
+CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_6_ret,%RET_VEC(Sp(SP_OFF),6))
+CATCH_RETRY_FRAME_ENTRY_TEMPLATE(stg_catch_retry_frame_7_ret,%RET_VEC(Sp(SP_OFF),7))
+
+#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)
+CATCH_RETRY_FRAME_ENTRY_TEMPLATE(,%ENTRY_CODE(Sp(SP_OFF)))
+
+
+
+// Atomically frame -------------------------------------------------------------
+
+#define ATOMICALLY_FRAME_ENTRY_TEMPLATE(label,ret) \
+ label \
+ { \
+ 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(trec "ptr"); \
+ if (valid) { \
+ /* Previous attempt is still valid: no point trying again yet */ \
+ IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;) \
+ 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; /* 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 ret; \
+ } 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); \
+ } \
+ } \
+ }
+
+ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_0_ret,%RET_VEC(Sp(SP_OFF),0))
+ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_1_ret,%RET_VEC(Sp(SP_OFF),1))
+ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_2_ret,%RET_VEC(Sp(SP_OFF),2))
+ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_3_ret,%RET_VEC(Sp(SP_OFF),3))
+ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_4_ret,%RET_VEC(Sp(SP_OFF),4))
+ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_5_ret,%RET_VEC(Sp(SP_OFF),5))
+ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_6_ret,%RET_VEC(Sp(SP_OFF),6))
+ATOMICALLY_FRAME_ENTRY_TEMPLATE(stg_atomically_frame_7_ret,%RET_VEC(Sp(SP_OFF),7))
+
+#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)
+ATOMICALLY_FRAME_ENTRY_TEMPLATE(,%ENTRY_CODE(Sp(SP_OFF)))
+
+
+// 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; // 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; // 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, readTVarzh_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; // 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) {
+ // Merge between siblings succeeded: commit it back to enclosing transaction
+ // and then propagate the retry
+ r = foreign "C" stmCommitTransaction(trec "ptr");
+ 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; // 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; // true
+ Sp = frame;
+ 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);
waitReadzh_fast
{
/* args: R1 */
+#ifdef THREADED_RTS
+ foreign "C" barf("waitRead# on threaded RTS");
+#endif
+
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
StgTSO_why_blocked(CurrentTSO) = BlockedOnRead::I16;
StgTSO_block_info(CurrentTSO) = R1;
waitWritezh_fast
{
/* args: R1 */
+#ifdef THREADED_RTS
+ foreign "C" barf("waitWrite# on threaded RTS");
+#endif
+
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
StgTSO_why_blocked(CurrentTSO) = BlockedOnWrite::I16;
StgTSO_block_info(CurrentTSO) = R1;
W_ t, prev, target;
#endif
+#ifdef THREADED_RTS
+ foreign "C" barf("delay# on threaded RTS");
+#endif
+
/* args: R1 (microsecond delay amount) */
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
StgTSO_why_blocked(CurrentTSO) = BlockedOnDelay::I16;
*/
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
}
W_ ares;
CInt reqID;
+#ifdef THREADED_RTS
+ foreign "C" barf("asyncRead# on threaded RTS");
+#endif
+
/* args: R1 = fd, R2 = isSock, R3 = len, R4 = buf */
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
StgTSO_why_blocked(CurrentTSO) = BlockedOnRead::I16;
W_ ares;
CInt reqID;
+#ifdef THREADED_RTS
+ foreign "C" barf("asyncWrite# on threaded RTS");
+#endif
+
/* args: R1 = fd, R2 = isSock, R3 = len, R4 = buf */
ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
StgTSO_why_blocked(CurrentTSO) = BlockedOnWrite::I16;
projects / ghc-hetmet.git / blobdiff