+
+FN_(makeStablePtrzh_fast)
+{
+ /* Args: R1 = a */
+ StgStablePtr sp;
+ FB_
+ MAYBE_GC(R1_PTR, makeStablePtrzh_fast);
+ sp = RET_STGCALL1(StgStablePtr,getStablePtr,R1.p);
+ RET_N(sp);
+ FE_
+}
+
+FN_(deRefStablePtrzh_fast)
+{
+ /* Args: R1 = the stable ptr */
+ P_ r;
+ StgStablePtr sp;
+ FB_
+ sp = (StgStablePtr)R1.w;
+ r = stable_ptr_table[(StgWord)sp].addr;
+ RET_P(r);
+ FE_
+}
+
+/* -----------------------------------------------------------------------------
+ Bytecode object primitives
+ ------------------------------------------------------------------------- */
+
+FN_(newBCOzh_fast)
+{
+ /* R1.p = instrs
+ R2.p = literals
+ R3.p = ptrs
+ R4.p = itbls
+ R5.i = arity
+ R6.p = bitmap array
+ */
+ StgBCO *bco;
+ nat size;
+ StgArrWords *bitmap_arr;
+ FB_
+
+ bitmap_arr = (StgArrWords *)R6.cl;
+ size = sizeofW(StgBCO) + bitmap_arr->words;
+ HP_CHK_GEN_TICKY(size,R1_PTR|R2_PTR|R3_PTR|R4_PTR|R6_PTR, newBCOzh_fast);
+ TICK_ALLOC_PRIM(size, size-sizeofW(StgHeader), 0);
+ CCS_ALLOC(CCCS,size); /* ccs prof */
+ bco = (StgBCO *) (Hp + 1 - size);
+ SET_HDR(bco, (const StgInfoTable *)&stg_BCO_info, CCCS);
+
+ bco->instrs = (StgArrWords*)R1.cl;
+ bco->literals = (StgArrWords*)R2.cl;
+ bco->ptrs = (StgMutArrPtrs*)R3.cl;
+ bco->itbls = (StgArrWords*)R4.cl;
+ bco->arity = R5.w;
+ bco->size = size;
+
+ // Copy the arity/bitmap info into the BCO
+ {
+ int i;
+ for (i = 0; i < bitmap_arr->words; i++) {
+ bco->bitmap[i] = bitmap_arr->payload[i];
+ }
+ }
+
+ TICK_RET_UNBOXED_TUP(1);
+ RET_P(bco);
+ FE_
+}
+
+FN_(mkApUpd0zh_fast)
+{
+ // R1.p = the BCO# for the AP
+ //
+ StgPAP* ap;
+ FB_
+
+ // 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(get_itbl(R1.cl)->type == BCO && ((StgBCO *)R1.p)->arity == 0);
+
+ HP_CHK_GEN_TICKY(PAP_sizeW(0), R1_PTR, mkApUpd0zh_fast);
+ TICK_ALLOC_PRIM(sizeofW(StgHeader), PAP_sizeW(0)-sizeofW(StgHeader), 0);
+ CCS_ALLOC(CCCS,PAP_sizeW(0)); /* ccs prof */
+ ap = (StgPAP *) (Hp + 1 - PAP_sizeW(0));
+ SET_HDR(ap, &stg_AP_info, CCCS);
+
+ ap->n_args = 0;
+ ap->fun = R1.cl;
+
+ TICK_RET_UNBOXED_TUP(1);
+ RET_P(ap);
+ FE_
+}
+
+/* -----------------------------------------------------------------------------
+ Thread I/O blocking primitives
+ -------------------------------------------------------------------------- */
+
+FN_(waitReadzh_fast)
+{
+ FB_
+ /* args: R1.i */
+ ASSERT(CurrentTSO->why_blocked == NotBlocked);
+ CurrentTSO->why_blocked = BlockedOnRead;
+ CurrentTSO->block_info.fd = R1.i;
+ ACQUIRE_LOCK(&sched_mutex);
+ APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
+ RELEASE_LOCK(&sched_mutex);
+ JMP_(stg_block_noregs);
+ FE_
+}
+
+FN_(waitWritezh_fast)
+{
+ FB_
+ /* args: R1.i */
+ ASSERT(CurrentTSO->why_blocked == NotBlocked);
+ CurrentTSO->why_blocked = BlockedOnWrite;
+ CurrentTSO->block_info.fd = R1.i;
+ ACQUIRE_LOCK(&sched_mutex);
+ APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
+ RELEASE_LOCK(&sched_mutex);
+ JMP_(stg_block_noregs);
+ FE_
+}
+
+FN_(delayzh_fast)
+{
+#ifdef mingw32_TARGET_OS
+ StgAsyncIOResult* ares;
+ unsigned int reqID;
+#else
+ StgTSO *t, *prev;
+ nat target;
+#endif
+ FB_
+ /* args: R1.i (microsecond delay amount) */
+ ASSERT(CurrentTSO->why_blocked == NotBlocked);
+ CurrentTSO->why_blocked = BlockedOnDelay;
+
+ ACQUIRE_LOCK(&sched_mutex);
+#ifdef mingw32_TARGET_OS
+ /* could probably allocate this on the heap instead */
+ ares = (StgAsyncIOResult*)RET_STGCALL2(P_,stgMallocBytes,sizeof(StgAsyncIOResult), "delayzh_fast");
+ reqID = RET_STGCALL1(W_,addDelayRequest,R1.i);
+ ares->reqID = reqID;
+ ares->len = 0;
+ ares->errCode = 0;
+ CurrentTSO->block_info.async_result = ares;
+ /* Having all async-blocked threads reside on the blocked_queue simplifies matters, so
+ * change the status to OnDoProc & put the delayed thread on the blocked_queue.
+ */
+ CurrentTSO->why_blocked = BlockedOnDoProc;
+ APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
+#else
+ target = ((R1.i + TICK_MILLISECS*1000-1) / (TICK_MILLISECS*1000)) + getourtimeofday();
+ CurrentTSO->block_info.target = target;
+
+ /* Insert the new thread in the sleeping queue. */
+ prev = NULL;
+ t = sleeping_queue;
+ while (t != END_TSO_QUEUE && t->block_info.target < target) {
+ prev = t;
+ t = t->link;
+ }
+
+ CurrentTSO->link = t;
+ if (prev == NULL) {
+ sleeping_queue = CurrentTSO;
+ } else {
+ prev->link = CurrentTSO;
+ }
+#endif
+ RELEASE_LOCK(&sched_mutex);
+ JMP_(stg_block_noregs);
+ FE_
+}
+
+#ifdef mingw32_TARGET_OS
+FN_(asyncReadzh_fast)
+{
+ StgAsyncIOResult* ares;
+ unsigned int reqID;
+ FB_
+ /* args: R1.i = fd, R2.i = isSock, R3.i = len, R4.p = buf */
+ ASSERT(CurrentTSO->why_blocked == NotBlocked);
+ CurrentTSO->why_blocked = BlockedOnRead;
+ ACQUIRE_LOCK(&sched_mutex);
+ /* could probably allocate this on the heap instead */
+ ares = (StgAsyncIOResult*)RET_STGCALL2(P_,stgMallocBytes,sizeof(StgAsyncIOResult), "asyncReadzh_fast");
+ reqID = RET_STGCALL5(W_,addIORequest,R1.i,FALSE,R2.i,R3.i,(char*)R4.p);
+ ares->reqID = reqID;
+ ares->len = 0;
+ ares->errCode = 0;
+ CurrentTSO->block_info.async_result = ares;
+ APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
+ RELEASE_LOCK(&sched_mutex);
+ JMP_(stg_block_async);
+ FE_
+}
+
+FN_(asyncWritezh_fast)
+{
+ StgAsyncIOResult* ares;
+ unsigned int reqID;
+ FB_
+ /* args: R1.i */
+ /* args: R1.i = fd, R2.i = isSock, R3.i = len, R4.p = buf */
+ ASSERT(CurrentTSO->why_blocked == NotBlocked);
+ CurrentTSO->why_blocked = BlockedOnWrite;
+ ACQUIRE_LOCK(&sched_mutex);
+ ares = (StgAsyncIOResult*)RET_STGCALL2(P_,stgMallocBytes,sizeof(StgAsyncIOResult), "asyncWritezh_fast");
+ reqID = RET_STGCALL5(W_,addIORequest,R1.i,TRUE,R2.i,R3.i,(char*)R4.p);
+ ares->reqID = reqID;
+ ares->len = 0;
+ ares->errCode = 0;
+ CurrentTSO->block_info.async_result = ares;
+ APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
+ RELEASE_LOCK(&sched_mutex);
+ JMP_(stg_block_async);
+ FE_
+}
+
+FN_(asyncDoProczh_fast)
+{
+ StgAsyncIOResult* ares;
+ unsigned int reqID;
+ FB_
+ /* args: R1.i = proc, R2.i = param */
+ ASSERT(CurrentTSO->why_blocked == NotBlocked);
+ CurrentTSO->why_blocked = BlockedOnDoProc;
+ ACQUIRE_LOCK(&sched_mutex);
+ /* could probably allocate this on the heap instead */
+ ares = (StgAsyncIOResult*)RET_STGCALL2(P_,stgMallocBytes,sizeof(StgAsyncIOResult), "asyncDoProczh_fast");
+ reqID = RET_STGCALL2(W_,addDoProcRequest,R1.p,R2.p);
+ ares->reqID = reqID;
+ ares->len = 0;
+ ares->errCode = 0;
+ CurrentTSO->block_info.async_result = ares;
+ APPEND_TO_BLOCKED_QUEUE(CurrentTSO);
+ RELEASE_LOCK(&sched_mutex);
+ JMP_(stg_block_async);
+ FE_
+}
+#endif