X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Frts%2FPrimOps.hc;h=39b4a74408a2a93e0cb5b55845c7d05a156b01d3;hb=b3c8ae4e104c93354738d3992fcf0e60e9646490;hp=08ca10a6cd9d7cebaf255623c54a80075e20b020;hpb=c6ab4bfa09886be3bfff4aa747af2f1c8e348a1f;p=ghc-hetmet.git diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc index 08ca10a..39b4a74 100644 --- a/ghc/rts/PrimOps.hc +++ b/ghc/rts/PrimOps.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.hc,v 1.29 1999/08/25 16:11:48 simonmar Exp $ + * $Id: PrimOps.hc,v 1.34 1999/11/09 15:46:53 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -55,7 +55,7 @@ W_ GHC_ZCCReturnable_static_info[0]; */ /*------ All Regs available */ -#ifdef REG_R8 +#if defined(REG_R8) # define RET_P(a) R1.w = (W_)(a); JMP_(ENTRY_CODE(Sp[0])); # define RET_N(a) RET_P(a) @@ -80,15 +80,60 @@ W_ GHC_ZCCReturnable_static_info[0]; R4.w = (W_)(d); R5.w = (W_)(e); R6.w = (W_)(f); \ JMP_(ENTRY_CODE(Sp[0])); -#else - -#if defined(REG_R7) || defined(REG_R6) || defined(REG_R5) || \ - defined(REG_R4) || defined(REG_R3) || defined(REG_R2) +#elif defined(REG_R7) || defined(REG_R6) || defined(REG_R5) || \ + defined(REG_R4) || defined(REG_R3) # error RET_n macros not defined for this setup. -#else + +/*------ 2 Registers available */ +#elif defined(REG_R2) + +# define RET_P(a) R1.w = (W_)(a); JMP_(ENTRY_CODE(Sp[0])); +# define RET_N(a) RET_P(a) + +# define RET_PP(a,b) R1.w = (W_)(a); R2.w = (W_)(b); \ + JMP_(ENTRY_CODE(Sp[0])); +# define RET_NN(a,b) RET_PP(a,b) +# define RET_NP(a,b) RET_PP(a,b) + +# define RET_PPP(a,b,c) \ + R1.w = (W_)(a); R2.w = (W_)(b); Sp[-1] = (W_)(c); Sp -= 1; \ + JMP_(ENTRY_CODE(Sp[1])); +# define RET_NNP(a,b,c) \ + R1.w = (W_)(a); R2.w = (W_)(b); Sp[-1] = (W_)(c); Sp -= 1; \ + JMP_(ENTRY_CODE(Sp[1])); + +# define RET_NNNP(a,b,c,d) \ + R1.w = (W_)(a); \ + R2.w = (W_)(b); \ + /* Sp[-3] = ARGTAG(1); */ \ + Sp[-2] = (W_)(c); \ + Sp[-1] = (W_)(d); \ + Sp -= 3; \ + JMP_(ENTRY_CODE(Sp[3])); + +# define RET_NPNP(a,b,c,d) \ + R1.w = (W_)(a); \ + R2.w = (W_)(b); \ + /* Sp[-3] = ARGTAG(1); */ \ + Sp[-2] = (W_)(c); \ + Sp[-1] = (W_)(d); \ + Sp -= 3; \ + JMP_(ENTRY_CODE(Sp[3])); + +# define RET_NNPNNP(a,b,c,d,e,f) \ + R1.w = (W_)(a); \ + R2.w = (W_)(b); \ + Sp[-6] = (W_)(c); \ + /* Sp[-5] = ARGTAG(1); */ \ + Sp[-4] = (W_)(d); \ + /* Sp[-3] = ARGTAG(1); */ \ + Sp[-2] = (W_)(e); \ + Sp[-1] = (W_)(f); \ + Sp -= 6; \ + JMP_(ENTRY_CODE(Sp[6])); /*------ 1 Register available */ -#ifdef REG_R1 +#elif defined(REG_R1) # define RET_P(a) R1.w = (W_)(a); JMP_(ENTRY_CODE(Sp[0])); # define RET_N(a) RET_P(a) @@ -176,9 +221,6 @@ W_ GHC_ZCCReturnable_static_info[0]; #endif -#endif -#endif - /*----------------------------------------------------------------------------- Array Primitives @@ -257,7 +299,7 @@ FN_(newMutVarzh_fast) /* Args: R1.p = initialisation value */ FB_ - HP_CHK_GEN(sizeofW(StgMutVar), R1_PTR, newMutVarzh_fast,); + HP_CHK_GEN_TICKY(sizeofW(StgMutVar), R1_PTR, newMutVarzh_fast,); TICK_ALLOC_PRIM(sizeofW(StgHeader)+1,1, 0); /* hack, dependent on rep. */ CCS_ALLOC(CCCS,sizeofW(StgMutVar)); @@ -283,7 +325,7 @@ FN_(makeForeignObjzh_fast) StgForeignObj *result; FB_ - HP_CHK_GEN(sizeofW(StgForeignObj), NO_PTRS, makeForeignObjzh_fast,); + HP_CHK_GEN_TICKY(sizeofW(StgForeignObj), NO_PTRS, makeForeignObjzh_fast,); TICK_ALLOC_PRIM(sizeofW(StgHeader), sizeofW(StgForeignObj)-sizeofW(StgHeader), 0); CCS_ALLOC(CCCS,sizeofW(StgForeignObj)); /* ccs prof */ @@ -326,7 +368,7 @@ FN_(mkWeakzh_fast) StgWeak *w; FB_ - HP_CHK_GEN(sizeofW(StgWeak), R1_PTR|R2_PTR|R3_PTR, mkWeakzh_fast,); + HP_CHK_GEN_TICKY(sizeofW(StgWeak), R1_PTR|R2_PTR|R3_PTR, mkWeakzh_fast,); TICK_ALLOC_PRIM(sizeofW(StgHeader)+1, // +1 is for the link field sizeofW(StgWeak)-sizeofW(StgHeader)-1, 0); CCS_ALLOC(CCCS,sizeofW(StgWeak)); /* ccs prof */ @@ -395,7 +437,7 @@ FN_(int2Integerzh_fast) FB_ val = R1.i; - HP_CHK_GEN(sizeofW(StgArrWords)+1, NO_PTRS, int2Integerzh_fast,); + HP_CHK_GEN_TICKY(sizeofW(StgArrWords)+1, NO_PTRS, int2Integerzh_fast,); TICK_ALLOC_PRIM(sizeofW(StgArrWords),1,0); CCS_ALLOC(CCCS,sizeofW(StgArrWords)+1); /* ccs prof */ @@ -432,7 +474,7 @@ FN_(word2Integerzh_fast) FB_ val = R1.w; - HP_CHK_GEN(sizeofW(StgArrWords)+1, NO_PTRS, word2Integerzh_fast,) + HP_CHK_GEN_TICKY(sizeofW(StgArrWords)+1, NO_PTRS, word2Integerzh_fast,) TICK_ALLOC_PRIM(sizeofW(StgArrWords),1,0); CCS_ALLOC(CCCS,sizeofW(StgArrWords)+1); /* ccs prof */ @@ -505,7 +547,7 @@ FN_(int64ToIntegerzh_fast) /* minimum is one word */ words_needed = 1; } - HP_CHK_GEN(sizeofW(StgArrWords)+words_needed, NO_PTRS, int64ToIntegerzh_fast,) + HP_CHK_GEN_TICKY(sizeofW(StgArrWords)+words_needed, NO_PTRS, int64ToIntegerzh_fast,) TICK_ALLOC_PRIM(sizeofW(StgArrWords),words_needed,0); CCS_ALLOC(CCCS,sizeofW(StgArrWords)+words_needed); /* ccs prof */ @@ -556,7 +598,7 @@ FN_(word64ToIntegerzh_fast) } else { words_needed = 1; } - HP_CHK_GEN(sizeofW(StgArrWords)+words_needed, NO_PTRS, word64ToIntegerzh_fast,) + HP_CHK_GEN_TICKY(sizeofW(StgArrWords)+words_needed, NO_PTRS, word64ToIntegerzh_fast,) TICK_ALLOC_PRIM(sizeofW(StgArrWords),words_needed,0); CCS_ALLOC(CCCS,sizeofW(StgArrWords)+words_needed); /* ccs prof */ @@ -682,7 +724,7 @@ FN_(decodeFloatzh_fast) /* arguments: F1 = Float# */ arg = F1; - HP_CHK_GEN(sizeofW(StgArrWords)+1, NO_PTRS, decodeFloatzh_fast,); + HP_CHK_GEN_TICKY(sizeofW(StgArrWords)+1, NO_PTRS, decodeFloatzh_fast,); TICK_ALLOC_PRIM(sizeofW(StgArrWords),1,0); CCS_ALLOC(CCCS,sizeofW(StgArrWords)+1); /* ccs prof */ @@ -715,7 +757,7 @@ FN_(decodeDoublezh_fast) /* arguments: D1 = Double# */ arg = D1; - HP_CHK_GEN(ARR_SIZE, NO_PTRS, decodeDoublezh_fast,); + HP_CHK_GEN_TICKY(ARR_SIZE, NO_PTRS, decodeDoublezh_fast,); TICK_ALLOC_PRIM(sizeofW(StgArrWords),DOUBLE_MANTISSA_SIZE,0); CCS_ALLOC(CCCS,ARR_SIZE); /* ccs prof */ @@ -748,6 +790,7 @@ FN_(forkzh_fast) /* create it right now, return ThreadID in R1 */ R1.t = RET_STGCALL2(StgTSO *, createIOThread, RtsFlags.GcFlags.initialStkSize, R1.cl); + STGCALL1(scheduleThread, R1.t); /* switch at the earliest opportunity */ context_switch = 1; @@ -807,13 +850,13 @@ FN_(newMVarzh_fast) FB_ /* args: none */ - HP_CHK_GEN(sizeofW(StgMVar), NO_PTRS, newMVarzh_fast,); + HP_CHK_GEN_TICKY(sizeofW(StgMVar), NO_PTRS, newMVarzh_fast,); TICK_ALLOC_PRIM(sizeofW(StgMutVar)-1, // consider head,tail,link as admin wds 1, 0); CCS_ALLOC(CCCS,sizeofW(StgMVar)); /* ccs prof */ mvar = (StgMVar *) (Hp - sizeofW(StgMVar) + 1); - SET_INFO(mvar,&EMPTY_MVAR_info); + SET_HDR(mvar,&EMPTY_MVAR_info,CCCS); mvar->head = mvar->tail = (StgTSO *)&END_TSO_QUEUE_closure; mvar->value = (StgClosure *)&END_TSO_QUEUE_closure; @@ -826,16 +869,23 @@ FN_(takeMVarzh_fast) { StgMVar *mvar; StgClosure *val; + const StgInfoTable *info; FB_ /* args: R1 = MVar closure */ mvar = (StgMVar *)R1.p; +#ifdef SMP + info = LOCK_CLOSURE(mvar); +#else + info = GET_INFO(mvar); +#endif + /* If the MVar is empty, put ourselves on its blocking queue, * and wait until we're woken up. */ - if (GET_INFO(mvar) != &FULL_MVAR_info) { + if (info == &EMPTY_MVAR_info) { if (mvar->head == (StgTSO *)&END_TSO_QUEUE_closure) { mvar->head = CurrentTSO; } else { @@ -846,13 +896,21 @@ FN_(takeMVarzh_fast) CurrentTSO->block_info.closure = (StgClosure *)mvar; mvar->tail = CurrentTSO; +#ifdef SMP + /* unlock the MVar */ + mvar->header.info = &EMPTY_MVAR_info; +#endif BLOCK(R1_PTR, takeMVarzh_fast); } - SET_INFO(mvar,&EMPTY_MVAR_info); val = mvar->value; mvar->value = (StgClosure *)&END_TSO_QUEUE_closure; + /* do this last... we might have locked the MVar in the SMP case, + * and writing the info pointer will unlock it. + */ + SET_INFO(mvar,&EMPTY_MVAR_info); + TICK_RET_UNBOXED_TUP(1); RET_P(val); FE_ @@ -861,17 +919,24 @@ FN_(takeMVarzh_fast) FN_(putMVarzh_fast) { StgMVar *mvar; + const StgInfoTable *info; FB_ /* args: R1 = MVar, R2 = value */ mvar = (StgMVar *)R1.p; - if (GET_INFO(mvar) == &FULL_MVAR_info) { + +#ifdef SMP + info = LOCK_CLOSURE(mvar); +#else + info = GET_INFO(mvar); +#endif + + if (info == &FULL_MVAR_info) { fprintf(stderr, "putMVar#: MVar already full.\n"); stg_exit(EXIT_FAILURE); } - SET_INFO(mvar,&FULL_MVAR_info); mvar->value = R2.cl; /* wake up the first thread on the queue, it will continue with the @@ -885,6 +950,9 @@ FN_(putMVarzh_fast) } } + /* unlocks the MVar in the SMP case */ + SET_INFO(mvar,&FULL_MVAR_info); + /* ToDo: yield here for better communication performance? */ JMP_(ENTRY_CODE(Sp[0])); FE_ @@ -900,7 +968,7 @@ FN_(makeStableNamezh_fast) StgStableName *sn_obj; FB_ - HP_CHK_GEN(sizeofW(StgStableName), R1_PTR, makeStableNamezh_fast,); + HP_CHK_GEN_TICKY(sizeofW(StgStableName), R1_PTR, makeStableNamezh_fast,); TICK_ALLOC_PRIM(sizeofW(StgHeader), sizeofW(StgStableName)-sizeofW(StgHeader), 0); CCS_ALLOC(CCCS,sizeofW(StgStableName)); /* ccs prof */ @@ -932,7 +1000,9 @@ FN_(waitReadzh_fast) ASSERT(CurrentTSO->why_blocked == NotBlocked); CurrentTSO->why_blocked = BlockedOnRead; CurrentTSO->block_info.fd = R1.i; - PUSH_ON_BLOCKED_QUEUE(CurrentTSO); + ACQUIRE_LOCK(&sched_mutex); + APPEND_TO_BLOCKED_QUEUE(CurrentTSO); + RELEASE_LOCK(&sched_mutex); JMP_(stg_block_noregs); FE_ } @@ -944,7 +1014,9 @@ FN_(waitWritezh_fast) ASSERT(CurrentTSO->why_blocked == NotBlocked); CurrentTSO->why_blocked = BlockedOnWrite; CurrentTSO->block_info.fd = R1.i; - PUSH_ON_BLOCKED_QUEUE(CurrentTSO); + ACQUIRE_LOCK(&sched_mutex); + APPEND_TO_BLOCKED_QUEUE(CurrentTSO); + RELEASE_LOCK(&sched_mutex); JMP_(stg_block_noregs); FE_ } @@ -956,12 +1028,16 @@ FN_(delayzh_fast) ASSERT(CurrentTSO->why_blocked == NotBlocked); CurrentTSO->why_blocked = BlockedOnDelay; + ACQUIRE_LOCK(&sched_mutex); + /* Add on ticks_since_select, since these will be subtracted at * the next awaitEvent call. */ CurrentTSO->block_info.delay = R1.i + ticks_since_select; - PUSH_ON_BLOCKED_QUEUE(CurrentTSO); + APPEND_TO_BLOCKED_QUEUE(CurrentTSO); + + RELEASE_LOCK(&sched_mutex); JMP_(stg_block_noregs); FE_ }