X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FPrimOps.hc;h=53fabf63f7409b671ac553258b98d19ef6853ca7;hb=ce42f19f8c840fbe89844471a0d850d310a94556;hp=e4ef7e74bfc3840a629a490c2ea61ac0d50f8695;hpb=0bffc410964e1688ad80d277d53400659e697ab5;p=ghc-hetmet.git diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc index e4ef7e7..53fabf6 100644 --- a/ghc/rts/PrimOps.hc +++ b/ghc/rts/PrimOps.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.hc,v 1.103 2002/12/11 15:36:45 simonmar Exp $ + * $Id: PrimOps.hc,v 1.112 2003/09/12 16:32:13 sof Exp $ * * (c) The GHC Team, 1998-2002 * @@ -19,8 +19,11 @@ #include "BlockAlloc.h" /* tmp */ #include "StablePriv.h" #include "StgRun.h" -#include "Itimer.h" +#include "Timer.h" /* TICK_MILLISECS */ #include "Prelude.h" +#ifndef mingw32_TARGET_OS +#include "Itimer.h" /* getourtimeofday() */ +#endif #ifdef HAVE_SYS_TYPES_H # include @@ -28,6 +31,11 @@ #include +#ifdef mingw32_TARGET_OS +#include +#include "win32/AsyncIO.h" +#endif + /* ** temporary ** classes CCallable and CReturnable don't really exist, but the @@ -180,7 +188,7 @@ StgWord GHC_ZCCReturnable_static_info[1]; #define PUSHED(m) Sp -= (m); JMP_(ENTRY_CODE(Sp[m])); # define RET_P(a) PUSH(1,a); PUSHED(1) -# define RET_N(a) PUSH(1,a); PUSHED(2) +# define RET_N(a) PUSH(1,a); PUSHED(1) # define RET_PP(a,b) PUSH(2,a); PUSH(1,b); PUSHED(2) # define RET_NN(a,b) PUSH(2,a); PUSH(1,b); PUSHED(2) @@ -360,7 +368,6 @@ FN_(atomicModifyMutVarzh_fast) r->payload[0] = z; RET_P(r); - JMP_(ENTRY_CODE(Sp[0])); FE_ } @@ -1056,8 +1063,7 @@ FN_(forkProcesszh_fast) R1.i = RET_STGCALL1(StgInt, forkProcess, CurrentTSO); - JMP_(ENTRY_CODE(Sp[0])); - + RET_N(R1.i); FE_ } @@ -1517,20 +1523,36 @@ FN_(newBCOzh_fast) R2.p = literals R3.p = ptrs R4.p = itbls + R5.i = arity + R6.p = bitmap array */ StgBCO *bco; + nat size; + StgArrWords *bitmap_arr; FB_ - HP_CHK_GEN_TICKY(sizeofW(StgBCO),R1_PTR|R2_PTR|R3_PTR|R4_PTR, newBCOzh_fast); - TICK_ALLOC_PRIM(sizeofW(StgHeader), sizeofW(StgBCO)-sizeofW(StgHeader), 0); - CCS_ALLOC(CCCS,sizeofW(StgBCO)); /* ccs prof */ - bco = (StgBCO *) (Hp + 1 - sizeofW(StgBCO)); + 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); @@ -1547,7 +1569,7 @@ FN_(mkApUpd0zh_fast) // 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 && BCO_ARITY(R1.p) == 0); + 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); @@ -1597,15 +1619,33 @@ FN_(waitWritezh_fast) FN_(delayzh_fast) { +#ifdef mingw32_TARGET_OS + StgAsyncIOResult* ares; + unsigned int reqID; +#else StgTSO *t, *prev; nat target; +#endif FB_ - /* args: R1.i */ + /* 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)) + getourtimeofday(); CurrentTSO->block_info.target = target; @@ -1623,9 +1663,76 @@ FN_(delayzh_fast) } 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