X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FPrimOps.h;h=2edd62be588965f767376fb7c9edd1180169388f;hb=99b05ba9a0249b464ffec7a7c6de58a724a9af83;hp=6ae67dbfc0ab57c185acbb4263b7d0982909c09c;hpb=fad03b44a0a09cb02f01427c14196d05a373e1c5;p=ghc-hetmet.git diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h index 6ae67db..2edd62b 100644 --- a/ghc/includes/PrimOps.h +++ b/ghc/includes/PrimOps.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.h,v 1.33 1999/07/29 10:00:22 simonmar Exp $ + * $Id: PrimOps.h,v 1.53 2000/05/10 11:02:00 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -127,12 +127,12 @@ I_ stg_div (I_ a, I_ b); #define mulIntCzh(r,c,a,b) \ { \ - __asm__("xor %1,%1\n\t \ + __asm__("xorl %1,%1\n\t \ imull %2,%3\n\t \ jno 1f\n\t \ movl $1,%1\n\t \ 1:" \ - : "=r" (r), "=r" (c) : "r" (a), "0" (b)); \ + : "=r" (r), "=&r" (c) : "r" (a), "0" (b)); \ } #elif SIZEOF_VOID_P == 4 @@ -221,15 +221,16 @@ typedef union { #define int2Addrzh(r,a) r=(A_)(a) #define addr2Intzh(r,a) r=(I_)(a) -#define indexCharOffAddrzh(r,a,i) r= ((C_ *)(a))[i] -#define indexIntOffAddrzh(r,a,i) r= ((I_ *)(a))[i] -#define indexAddrOffAddrzh(r,a,i) r= ((PP_)(a))[i] -#define indexFloatOffAddrzh(r,a,i) r= PK_FLT((P_) (((StgFloat *)(a)) + i)) -#define indexDoubleOffAddrzh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i)) -#define indexStablePtrOffAddrzh(r,a,i) r= ((StgStablePtr *)(a))[i] +#define readCharOffAddrzh(r,a,i) r= ((C_ *)(a))[i] +#define readIntOffAddrzh(r,a,i) r= ((I_ *)(a))[i] +#define readWordOffAddrzh(r,a,i) r= ((W_ *)(a))[i] +#define readAddrOffAddrzh(r,a,i) r= ((PP_)(a))[i] +#define readFloatOffAddrzh(r,a,i) r= PK_FLT((P_) (((StgFloat *)(a)) + i)) +#define readDoubleOffAddrzh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i)) +#define readStablePtrOffAddrzh(r,a,i) r= ((StgStablePtr *)(a))[i] #ifdef SUPPORT_LONG_LONGS -#define indexInt64OffAddrzh(r,a,i) r= ((LI_ *)(a))[i] -#define indexWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i] +#define readInt64OffAddrzh(r,a,i) r= ((LI_ *)(a))[i] +#define readWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i] #endif #define writeCharOffAddrzh(a,i,v) ((C_ *)(a))[i] = (v) @@ -245,6 +246,18 @@ typedef union { #define writeWord64OffAddrzh(a,i,v) ((LW_ *)(a))[i] = (v) #endif +#define indexCharOffAddrzh(r,a,i) r= ((C_ *)(a))[i] +#define indexIntOffAddrzh(r,a,i) r= ((I_ *)(a))[i] +#define indexWordOffAddrzh(r,a,i) r= ((W_ *)(a))[i] +#define indexAddrOffAddrzh(r,a,i) r= ((PP_)(a))[i] +#define indexFloatOffAddrzh(r,a,i) r= PK_FLT((P_) (((StgFloat *)(a)) + i)) +#define indexDoubleOffAddrzh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i)) +#define indexStablePtrOffAddrzh(r,a,i) r= ((StgStablePtr *)(a))[i] +#ifdef SUPPORT_LONG_LONGS +#define indexInt64OffAddrzh(r,a,i) r= ((LI_ *)(a))[i] +#define indexWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i] +#endif + /* ----------------------------------------------------------------------------- Float PrimOps. -------------------------------------------------------------------------- */ @@ -355,6 +368,20 @@ typedef union { (r) = RET_PRIM_STGCALL2(I_,mpz_cmp_si,&arg,i); \ } +/* I think mp_limb_t must be the same size as StgInt for this to work + * properly --SDM + */ +#define gcdIntzh(r,a,b) \ +{ StgInt aa = a; \ + r = (aa) ? (b) ? \ + RET_STGCALL3(StgInt, mpn_gcd_1, (mp_limb_t *)(&aa), 1, (mp_limb_t)(b)) \ + : abs(aa) \ + : abs(b); \ +} + +#define gcdIntegerIntzh(r,a,sb,b) \ + RET_STGCALL3(StgInt, mpn_gcd_1, (unsigned long int *) b, sb, (mp_limb_t)(a)) + /* The rest are all out-of-line: -------- */ /* Integer arithmetic */ @@ -363,6 +390,9 @@ EF_(minusIntegerzh_fast); EF_(timesIntegerzh_fast); EF_(gcdIntegerzh_fast); EF_(quotRemIntegerzh_fast); +EF_(quotIntegerzh_fast); +EF_(remIntegerzh_fast); +EF_(divExactIntegerzh_fast); EF_(divModIntegerzh_fast); /* Conversions */ @@ -543,29 +573,6 @@ extern I_ resetGenSymZh(void); #define indexWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i) #endif -#define indexCharOffForeignObjzh(r,fo,i) indexCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexIntOffForeignObjzh(r,fo,i) indexIntOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexWordOffForeignObjzh(r,fo,i) indexWordOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexAddrOffForeignObjzh(r,fo,i) indexAddrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexFloatOffForeignObjzh(r,fo,i) indexFloatOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexDoubleOffForeignObjzh(r,fo,i) indexDoubleOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexStablePtrOffForeignObjzh(r,fo,i) indexStablePtrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) -#ifdef SUPPORT_LONG_LONGS -#define indexInt64OffForeignObjzh(r,fo,i) indexInt64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) -#define indexWord64OffForeignObjzh(r,fo,i) indexWord64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) -#endif - -#define indexCharOffAddrzh(r,a,i) r= ((C_ *)(a))[i] -#define indexIntOffAddrzh(r,a,i) r= ((I_ *)(a))[i] -#define indexWordOffAddrzh(r,a,i) r= ((W_ *)(a))[i] -#define indexAddrOffAddrzh(r,a,i) r= ((PP_)(a))[i] -#define indexFloatOffAddrzh(r,a,i) r= PK_FLT((P_) (((StgFloat *)(a)) + i)) -#define indexDoubleOffAddrzh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i)) -#ifdef SUPPORT_LONG_LONGS -#define indexInt64OffAddrzh(r,a,i) r= ((LI_ *)(a))[i] -#define indexWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i] -#endif - /* Freezing arrays-of-ptrs requires changing an info table, for the benefit of the generational collector. It needs to scavenge mutable objects, even if they are in old space. When they become immutable, @@ -578,7 +585,6 @@ extern I_ resetGenSymZh(void); } #define unsafeFreezzeByteArrayzh(r,a) r=(a) -#define unsafeThawByteArrayzh(r,a) r=(a) EF_(unsafeThawArrayzh_fast); @@ -656,6 +662,7 @@ EF_(newMutVarzh_fast); #define isEmptyMVarzh(r,a) r=(I_)((GET_INFO((StgMVar*)(a))) == &EMPTY_MVAR_info ) EF_(newMVarzh_fast); EF_(takeMVarzh_fast); +EF_(tryTakeMVarzh_fast); EF_(putMVarzh_fast); @@ -663,7 +670,9 @@ EF_(putMVarzh_fast); Delay/Wait PrimOps -------------------------------------------------------------------------- */ -/* Hmm, I'll think about these later. */ +EF_(waitReadzh_fast); +EF_(waitWritezh_fast); +EF_(delayzh_fast); /* ----------------------------------------------------------------------------- Primitive I/O, error-handling PrimOps @@ -691,27 +700,122 @@ EF_(makeStableNamezh_fast); r = RET_STGCALL1(StgStablePtr,getStablePtr,a) #define deRefStablePtrzh(r,sp) do { \ - ASSERT(stable_ptr_table[sp & ~STABLEPTR_WEIGHT_MASK].weight > 0); \ - r = stable_ptr_table[sp & ~STABLEPTR_WEIGHT_MASK].addr; \ + ASSERT(stable_ptr_table[stgCast(StgWord,sp) & ~STABLEPTR_WEIGHT_MASK].weight > 0); \ + r = stable_ptr_table[stgCast(StgWord,sp) & ~STABLEPTR_WEIGHT_MASK].addr; \ } while (0); #define eqStablePtrzh(r,sp1,sp2) \ - (r = ((sp1 & ~STABLEPTR_WEIGHT_MASK) == (sp2 & ~STABLEPTR_WEIGHT_MASK))) + (r = ((stgCast(StgWord,sp1) & ~STABLEPTR_WEIGHT_MASK) == (stgCast(StgWord,sp2) & ~STABLEPTR_WEIGHT_MASK))) #endif /* ----------------------------------------------------------------------------- - Parallel PrimOps. + Concurrency/Exception PrimOps. -------------------------------------------------------------------------- */ EF_(forkzh_fast); EF_(yieldzh_fast); EF_(killThreadzh_fast); EF_(seqzh_fast); +EF_(blockAsyncExceptionszh_fast); +EF_(unblockAsyncExceptionszh_fast); #define myThreadIdzh(t) (t = CurrentTSO) -/* Hmm, I'll think about these later. */ +extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2); + +/* ------------------------------------------------------------------------ + Parallel PrimOps + + A par in the Haskell code is ultimately translated to a parzh macro + (with a case wrapped around it to guarantee that the macro is actually + executed; see compiler/prelude/PrimOps.lhs) + In GUM and SMP we only add a pointer to the spark pool. + In GranSim we call an RTS fct, forwarding additional parameters which + supply info on granularity of the computation, size of the result value + and the degree of parallelism in the sparked expression. + ---------------------------------------------------------------------- */ + +#if defined(GRAN) +//@cindex _par_ +#define parzh(r,node) PAR(r,node,1,0,0,0,0,0) + +//@cindex _parAt_ +#define parAtzh(r,node,where,identifier,gran_info,size_info,par_info,rest) \ + parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,1) + +//@cindex _parAtAbs_ +#define parAtAbszh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \ + parAT(r,node,proc,identifier,gran_info,size_info,par_info,rest,2) + +//@cindex _parAtRel_ +#define parAtRelzh(r,node,proc,identifier,gran_info,size_info,par_info,rest) \ + parAT(r,node,proc,identifier,gran_info,size_info,par_info,rest,3) + +//@cindex _parAtForNow_ +#define parAtForNowzh(r,node,where,identifier,gran_info,size_info,par_info,rest) \ + parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,0) + +#define parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,local) \ +{ \ + if (closure_SHOULD_SPARK((StgClosure*)node)) { \ + rtsSparkQ result; \ + PEs p; \ + \ + STGCALL6(newSpark, node,identifier,gran_info,size_info,par_info,local); \ + switch (local) { \ + case 2: p = where; /* parAtAbs means absolute PE no. expected */ \ + break; \ + case 3: p = CurrentProc+where; /* parAtRel means rel PE no. expected */\ + break; \ + default: p = where_is(where); /* parAt means closure expected */ \ + break; \ + } \ + /* update GranSim state according to this spark */ \ + STGCALL3(GranSimSparkAtAbs, result, (I_)p, identifier); \ + } \ +} + +//@cindex _parLocal_ +#define parLocalzh(r,node,identifier,gran_info,size_info,par_info,rest) \ + PAR(r,node,rest,identifier,gran_info,size_info,par_info,1) + +//@cindex _parGlobal_ +#define parGlobalzh(r,node,identifier,gran_info,size_info,par_info,rest) \ + PAR(r,node,rest,identifier,gran_info,size_info,par_info,0) + +#define PAR(r,node,rest,identifier,gran_info,size_info,par_info,local) \ +{ \ + if (closure_SHOULD_SPARK((StgClosure*)node)) { \ + rtsSpark *result; \ + result = RET_STGCALL6(rtsSpark*, newSpark, \ + node,identifier,gran_info,size_info,par_info,local);\ + STGCALL1(add_to_spark_queue,result); \ + STGCALL2(GranSimSpark, local,(P_)node); \ + } \ +} + +#define copyablezh(r,node) \ + /* copyable not yet implemented!! */ + +#define noFollowzh(r,node) \ + /* noFollow not yet implemented!! */ + +#elif defined(SMP) || defined(PAR) + +#define parzh(r,node) \ +{ \ + extern unsigned int context_switch; \ + if (closure_SHOULD_SPARK((StgClosure *)node) && \ + SparkTl < SparkLim) { \ + *SparkTl++ = (StgClosure *)(node); \ + } \ + r = context_switch = 1; \ +} +#else /* !GRAN && !SMP && !PAR */ +#define parzh(r,node) r = 1 +#endif + /* ----------------------------------------------------------------------------- Pointer equality -------------------------------------------------------------------------- */ @@ -754,13 +858,25 @@ EF_(finalizzeWeakzh_fast); #define ForeignObj_CLOSURE_DATA(c) (((StgForeignObj *)c)->data) -EF_(makeForeignObjzh_fast); +EF_(mkForeignObjzh_fast); #define writeForeignObjzh(res,datum) \ (ForeignObj_CLOSURE_DATA(res) = (P_)(datum)) #define eqForeignObj(f1,f2) ((f1)==(f2)) +#define indexCharOffForeignObjzh(r,fo,i) indexCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexIntOffForeignObjzh(r,fo,i) indexIntOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexWordOffForeignObjzh(r,fo,i) indexWordOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexAddrOffForeignObjzh(r,fo,i) indexAddrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexFloatOffForeignObjzh(r,fo,i) indexFloatOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexDoubleOffForeignObjzh(r,fo,i) indexDoubleOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexStablePtrOffForeignObjzh(r,fo,i) indexStablePtrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#ifdef SUPPORT_LONG_LONGS +#define indexInt64OffForeignObjzh(r,fo,i) indexInt64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#define indexWord64OffForeignObjzh(r,fo,i) indexWord64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i) +#endif + #endif /* ----------------------------------------------------------------------------- @@ -785,4 +901,4 @@ extern StgInt sig_install (StgInt, StgInt, StgStablePtr, sigset_t *); #define stg_sig_ignore(sig,mask) sig_install(sig,STG_SIG_IGN,0,(sigset_t *)mask) #define stg_sig_catch(sig,ptr,mask) sig_install(sig,STG_SIG_HAN,ptr,(sigset_t *)mask) -#endif PRIMOPS_H +#endif /* PRIMOPS_H */