X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FPrimOps.h;h=8c2b03e7c3fe84b4868edc8d0fa6b1738d5f6e8d;hb=f5448f5c5efe0630cb865ee0d21691a23ea932d3;hp=a436ee6fbd52d4d1101d9c03a2da1720bd4931d8;hpb=8ae10d70969e6c7ba0401aad96976ff7438fa6c7;p=ghc-hetmet.git diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h index a436ee6..8c2b03e 100644 --- a/ghc/includes/PrimOps.h +++ b/ghc/includes/PrimOps.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.h,v 1.47 2000/03/17 12:40:03 simonmar Exp $ + * $Id: PrimOps.h,v 1.65 2000/11/07 10:42:56 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -11,6 +11,39 @@ #define PRIMOPS_H /* ----------------------------------------------------------------------------- + Helpers for the metacircular interpreter. + -------------------------------------------------------------------------- */ + +#ifdef GHCI + +#define CHASE_INDIRECTIONS(lval) \ + do { \ + int again; \ + do { \ + again = 0; \ + if (get_itbl((StgClosure*)lval)->type == IND) \ + { again = 1; lval = ((StgInd*)lval)->indirectee; } \ + else \ + if (get_itbl((StgClosure*)lval)->type == IND_OLDGEN) \ + { again = 1; lval = ((StgIndOldGen*)lval)->indirectee; } \ + } while (again); \ + } while (0) + +#define indexWordOffClosurezh(r,a,i) \ + do { StgClosure* tmp = (StgClosure*)(a); \ + CHASE_INDIRECTIONS(tmp); \ + r = ((W_ *)tmp)[i]; \ + } while (0) + +#define indexPtrOffClosurezh(r,a,i) \ + do { StgClosure* tmp = (StgClosure*)(a); \ + CHASE_INDIRECTIONS(tmp); \ + r = ((P_ *)tmp)[i]; \ + } while (0) + +#endif + +/* ----------------------------------------------------------------------------- Comparison PrimOps. -------------------------------------------------------------------------- */ @@ -221,7 +254,8 @@ typedef union { #define int2Addrzh(r,a) r=(A_)(a) #define addr2Intzh(r,a) r=(I_)(a) -#define readCharOffAddrzh(r,a,i) r= ((C_ *)(a))[i] +#define readCharOffAddrzh(r,a,i) r= ((unsigned char *)(a))[i] +/* unsigned char is for compatibility: the index is still in bytes. */ #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] @@ -233,7 +267,8 @@ typedef union { #define readWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i] #endif -#define writeCharOffAddrzh(a,i,v) ((C_ *)(a))[i] = (v) +#define writeCharOffAddrzh(a,i,v) ((unsigned char *)(a))[i] = (unsigned char)(v) +/* unsigned char is for compatibility: the index is still in bytes. */ #define writeIntOffAddrzh(a,i,v) ((I_ *)(a))[i] = (v) #define writeWordOffAddrzh(a,i,v) ((W_ *)(a))[i] = (v) #define writeAddrOffAddrzh(a,i,v) ((PP_)(a))[i] = (v) @@ -246,7 +281,8 @@ typedef union { #define writeWord64OffAddrzh(a,i,v) ((LW_ *)(a))[i] = (v) #endif -#define indexCharOffAddrzh(r,a,i) r= ((C_ *)(a))[i] +#define indexCharOffAddrzh(r,a,i) r= ((unsigned char *)(a))[i] +/* unsigned char is for compatibility: the index is still in bytes. */ #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] @@ -368,41 +404,43 @@ 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 - */ +/* NOTE: gcdIntzh and gcdIntegerIntzh work only for positive inputs! */ + +/* mp_limb_t must be able to hold an StgInt for this to work properly */ #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); \ +{ mp_limb_t aa = (mp_limb_t)(a); \ + r = RET_STGCALL3(StgInt, mpn_gcd_1, (mp_limb_t *)(&aa), 1, (mp_limb_t)(b)); \ } -#define gcdIntegerIntzh(r,a,sb,b) \ - RET_STGCALL3(StgInt, mpn_gcd_1, (unsigned long int *) b, sb, (mp_limb_t)(a)) +#define gcdIntegerIntzh(r,sa,a,b) \ + r = RET_STGCALL3(StgInt, mpn_gcd_1, (mp_limb_t *)(BYTE_ARR_CTS(a)), sa, b) /* The rest are all out-of-line: -------- */ /* Integer arithmetic */ -EF_(plusIntegerzh_fast); -EF_(minusIntegerzh_fast); -EF_(timesIntegerzh_fast); -EF_(gcdIntegerzh_fast); -EF_(quotRemIntegerzh_fast); -EF_(quotIntegerzh_fast); -EF_(remIntegerzh_fast); -EF_(divExactIntegerzh_fast); -EF_(divModIntegerzh_fast); +EXTFUN_RTS(plusIntegerzh_fast); +EXTFUN_RTS(minusIntegerzh_fast); +EXTFUN_RTS(timesIntegerzh_fast); +EXTFUN_RTS(gcdIntegerzh_fast); +EXTFUN_RTS(quotRemIntegerzh_fast); +EXTFUN_RTS(quotIntegerzh_fast); +EXTFUN_RTS(remIntegerzh_fast); +EXTFUN_RTS(divExactIntegerzh_fast); +EXTFUN_RTS(divModIntegerzh_fast); /* Conversions */ -EF_(int2Integerzh_fast); -EF_(word2Integerzh_fast); -EF_(addr2Integerzh_fast); +EXTFUN_RTS(int2Integerzh_fast); +EXTFUN_RTS(word2Integerzh_fast); /* Floating-point decodings */ -EF_(decodeFloatzh_fast); -EF_(decodeDoublezh_fast); +EXTFUN_RTS(decodeFloatzh_fast); +EXTFUN_RTS(decodeDoublezh_fast); + +/* Bit operations */ +EXTFUN_RTS(andIntegerzh_fast); +EXTFUN_RTS(orIntegerzh_fast); +EXTFUN_RTS(xorIntegerzh_fast); +EXTFUN_RTS(complementIntegerzh_fast); /* ----------------------------------------------------------------------------- Word64 PrimOps. @@ -410,46 +448,46 @@ EF_(decodeDoublezh_fast); #ifdef SUPPORT_LONG_LONGS -#define integerToWord64zh(r, sa,da) \ -{ unsigned long int* d; \ - I_ aa; \ - StgWord64 res; \ - \ - d = (unsigned long int *) (BYTE_ARR_CTS(da)); \ - aa = ((StgArrWords *)da)->words; \ - if ( (aa) == 0 ) { \ - res = (LW_)0; \ - } else if ( (aa) == 1) { \ - res = (LW_)d[0]; \ - } else { \ - res = (LW_)d[0] + (LW_)d[1] * 0x100000000ULL; \ - } \ - (r) = res; \ +#define integerToWord64zh(r, sa,da) \ +{ unsigned long int* d; \ + I_ s; \ + StgWord64 res; \ + \ + d = (unsigned long int *) (BYTE_ARR_CTS(da)); \ + s = (sa); \ + if ( s == 0 ) { \ + res = (LW_)0; \ + } else if ( s == 1) { \ + res = (LW_)d[0]; \ + } else { \ + res = (LW_)d[0] + (LW_)d[1] * 0x100000000ULL; \ + } \ + (r) = res; \ } -#define integerToInt64zh(r, sa,da) \ -{ unsigned long int* d; \ - I_ aa; \ - StgInt64 res; \ - \ - d = (unsigned long int *) (BYTE_ARR_CTS(da)); \ - aa = ((StgArrWords *)da)->words; \ - if ( (aa) == 0 ) { \ - res = (LI_)0; \ - } else if ( (aa) == 1) { \ - res = (LI_)d[0]; \ - } else { \ - res = (LI_)d[0] + (LI_)d[1] * 0x100000000LL; \ - if ( sa < 0 ) { \ - res = (LI_)-res; \ - } \ - } \ - (r) = res; \ +#define integerToInt64zh(r, sa,da) \ +{ unsigned long int* d; \ + I_ s; \ + StgInt64 res; \ + \ + d = (unsigned long int *) (BYTE_ARR_CTS(da)); \ + s = (sa); \ + if ( s == 0 ) { \ + res = (LI_)0; \ + } else if ( s == 1) { \ + res = (LI_)d[0]; \ + } else { \ + res = (LI_)d[0] + (LI_)d[1] * 0x100000000LL; \ + if ( s < 0 ) { \ + res = (LI_)-res; \ + } \ + } \ + (r) = res; \ } /* Conversions */ -EF_(int64ToIntegerzh_fast); -EF_(word64ToIntegerzh_fast); +EXTFUN_RTS(int64ToIntegerzh_fast); +EXTFUN_RTS(word64ToIntegerzh_fast); /* The rest are (way!) out of line, implemented via C entry points. */ @@ -545,7 +583,8 @@ extern I_ resetGenSymZh(void); /* result ("r") arg ignored in write macros! */ #define writeArrayzh(a,i,v) ((PP_) PTRS_ARR_CTS(a))[(i)]=(v) -#define writeCharArrayzh(a,i,v) ((C_ *)(BYTE_ARR_CTS(a)))[i] = (v) +#define writeCharArrayzh(a,i,v) ((unsigned char *)(BYTE_ARR_CTS(a)))[i] = (unsigned char)(v) +/* unsigned char is for compatibility: the index is still in bytes. */ #define writeIntArrayzh(a,i,v) ((I_ *)(BYTE_ARR_CTS(a)))[i] = (v) #define writeWordArrayzh(a,i,v) ((W_ *)(BYTE_ARR_CTS(a)))[i] = (v) #define writeAddrArrayzh(a,i,v) ((PP_)(BYTE_ARR_CTS(a)))[i] = (v) @@ -586,7 +625,7 @@ extern I_ resetGenSymZh(void); #define unsafeFreezzeByteArrayzh(r,a) r=(a) -EF_(unsafeThawArrayzh_fast); +EXTFUN_RTS(unsafeThawArrayzh_fast); #define sizzeofByteArrayzh(r,a) \ r = (((StgArrWords *)(a))->words * sizeof(W_)) @@ -595,14 +634,14 @@ EF_(unsafeThawArrayzh_fast); /* and the out-of-line ones... */ -EF_(newCharArrayzh_fast); -EF_(newIntArrayzh_fast); -EF_(newWordArrayzh_fast); -EF_(newAddrArrayzh_fast); -EF_(newFloatArrayzh_fast); -EF_(newDoubleArrayzh_fast); -EF_(newStablePtrArrayzh_fast); -EF_(newArrayzh_fast); +EXTFUN_RTS(newCharArrayzh_fast); +EXTFUN_RTS(newIntArrayzh_fast); +EXTFUN_RTS(newWordArrayzh_fast); +EXTFUN_RTS(newAddrArrayzh_fast); +EXTFUN_RTS(newFloatArrayzh_fast); +EXTFUN_RTS(newDoubleArrayzh_fast); +EXTFUN_RTS(newStablePtrArrayzh_fast); +EXTFUN_RTS(newArrayzh_fast); /* encoding and decoding of floats/doubles. */ @@ -615,10 +654,10 @@ EF_(newArrayzh_fast); #ifdef FLOATS_AS_DOUBLES #define decodeFloatzh_fast decodeDoublezh_fast #else -EF_(decodeFloatzh_fast); +EXTFUN_RTS(decodeFloatzh_fast); #endif -EF_(decodeDoublezh_fast); +EXTFUN_RTS(decodeDoublezh_fast); /* grimy low-level support functions defined in StgPrimFloat.c */ @@ -645,7 +684,7 @@ extern StgInt isFloatNegativeZero(StgFloat f); newMutVar is out of line. -------------------------------------------------------------------------- */ -EF_(newMutVarzh_fast); +EXTFUN_RTS(newMutVarzh_fast); #define readMutVarzh(r,a) r=(P_)(((StgMutVar *)(a))->var) #define writeMutVarzh(a,v) (P_)(((StgMutVar *)(a))->var)=(v) @@ -660,25 +699,26 @@ EF_(newMutVarzh_fast); /* Assume external decl of EMPTY_MVAR_info is in scope by now */ #define isEmptyMVarzh(r,a) r=(I_)((GET_INFO((StgMVar*)(a))) == &EMPTY_MVAR_info ) -EF_(newMVarzh_fast); -EF_(takeMVarzh_fast); -EF_(putMVarzh_fast); +EXTFUN_RTS(newMVarzh_fast); +EXTFUN_RTS(takeMVarzh_fast); +EXTFUN_RTS(tryTakeMVarzh_fast); +EXTFUN_RTS(putMVarzh_fast); /* ----------------------------------------------------------------------------- Delay/Wait PrimOps -------------------------------------------------------------------------- */ -EF_(waitReadzh_fast); -EF_(waitWritezh_fast); -EF_(delayzh_fast); +EXTFUN_RTS(waitReadzh_fast); +EXTFUN_RTS(waitWritezh_fast); +EXTFUN_RTS(delayzh_fast); /* ----------------------------------------------------------------------------- Primitive I/O, error-handling PrimOps -------------------------------------------------------------------------- */ -EF_(catchzh_fast); -EF_(raisezh_fast); +EXTFUN_RTS(catchzh_fast); +EXTFUN_RTS(raisezh_fast); extern void stg_exit(I_ n) __attribute__ ((noreturn)); @@ -688,7 +728,7 @@ extern void stg_exit(I_ n) __attribute__ ((noreturn)); #ifndef PAR -EF_(makeStableNamezh_fast); +EXTFUN_RTS(makeStableNamezh_fast); #define stableNameToIntzh(r,s) (r = ((StgStableName *)s)->sn) @@ -699,12 +739,12 @@ 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 @@ -712,12 +752,12 @@ EF_(makeStableNamezh_fast); Concurrency/Exception PrimOps. -------------------------------------------------------------------------- */ -EF_(forkzh_fast); -EF_(yieldzh_fast); -EF_(killThreadzh_fast); -EF_(seqzh_fast); -EF_(blockAsyncExceptionszh_fast); -EF_(unblockAsyncExceptionszh_fast); +EXTFUN_RTS(forkzh_fast); +EXTFUN_RTS(yieldzh_fast); +EXTFUN_RTS(killThreadzh_fast); +EXTFUN_RTS(seqzh_fast); +EXTFUN_RTS(blockAsyncExceptionszh_fast); +EXTFUN_RTS(unblockAsyncExceptionszh_fast); #define myThreadIdzh(t) (t = CurrentTSO) @@ -729,50 +769,61 @@ extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2); 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) -// hash coding changed from 2.10 to 4.00 -#define parzh(r,node) parZh(r,node) - -#define parZh(r,node) \ - PARZh(r,node,1,0,0,0,0,0) +//@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) \ - parATZh(r,node,where,identifier,gran_info,size_info,par_info,rest,1) + 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) \ - parATZh(r,node,proc,identifier,gran_info,size_info,par_info,rest,2) + 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) \ - parATZh(r,node,proc,identifier,gran_info,size_info,par_info,rest,3) + 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) \ - parATZh(r,node,where,identifier,gran_info,size_info,par_info,rest,0) + parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,0) -#define parATZh(r,node,where,identifier,gran_info,size_info,par_info,rest,local) \ -{ \ - rtsSparkQ result; \ - if (closure_SHOULD_SPARK((StgClosure*)node)) { \ +#define parAT(r,node,where,identifier,gran_info,size_info,par_info,rest,local) \ +{ \ + if (closure_SHOULD_SPARK((StgClosure*)node)) { \ rtsSparkQ result; \ - STGCALL6(newSpark, node,identifier,gran_info,size_info,par_info,local); \ - if (local==2) { /* special case for parAtAbs */ \ - STGCALL3(GranSimSparkAtAbs, result,(I_)where,identifier);\ - } else if (local==3) { /* special case for parAtRel */ \ - STGCALL3(GranSimSparkAtAbs, result,(I_)(CurrentProc+where),identifier); \ - } else { \ - STGCALL3(GranSimSparkAt, result,where,identifier); \ - } \ - } \ + 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) \ - PARZh(r,node,rest,identifier,gran_info,size_info,par_info,1) + 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) \ - PARZh(r,node,rest,identifier,gran_info,size_info,par_info,0) + PAR(r,node,rest,identifier,gran_info,size_info,par_info,0) -#define PARZh(r,node,rest,identifier,gran_info,size_info,par_info,local) \ +#define PAR(r,node,rest,identifier,gran_info,size_info,par_info,local) \ { \ if (closure_SHOULD_SPARK((StgClosure*)node)) { \ rtsSpark *result; \ @@ -789,9 +840,8 @@ extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2); #define noFollowzh(r,node) \ /* noFollow not yet implemented!! */ -#endif /* GRAN */ +#elif defined(SMP) || defined(PAR) -#if defined(SMP) || defined(PAR) #define parzh(r,node) \ { \ extern unsigned int context_switch; \ @@ -801,7 +851,7 @@ extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2); } \ r = context_switch = 1; \ } -#else +#else /* !GRAN && !SMP && !PAR */ #define parzh(r,node) r = 1 #endif @@ -823,8 +873,8 @@ extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2); #ifndef PAR -EF_(mkWeakzh_fast); -EF_(finalizzeWeakzh_fast); +EXTFUN_RTS(mkWeakzh_fast); +EXTFUN_RTS(finalizzeWeakzh_fast); #define deRefWeakzh(code,val,w) \ if (((StgWeak *)w)->header.info == &WEAK_info) { \ @@ -847,7 +897,10 @@ EF_(finalizzeWeakzh_fast); #define ForeignObj_CLOSURE_DATA(c) (((StgForeignObj *)c)->data) -EF_(makeForeignObjzh_fast); +#define foreignObjToAddrzh(r,fo) r=ForeignObj_CLOSURE_DATA(fo) +#define touchzh(o) /* nothing */ + +EXTFUN_RTS(mkForeignObjzh_fast); #define writeForeignObjzh(res,datum) \ (ForeignObj_CLOSURE_DATA(res) = (P_)(datum)) @@ -868,11 +921,22 @@ EF_(makeForeignObjzh_fast); #endif + /* ----------------------------------------------------------------------------- Constructor tags -------------------------------------------------------------------------- */ +#ifdef GHCI +#define dataToTagzh(r,a) \ + do { StgClosure* tmp = (StgClosure*)(a); \ + CHASE_INDIRECTIONS(tmp); \ + r = (GET_TAG(((StgClosure *)tmp)->header.info)); \ + } while (0) +#else +/* Original version doesn't chase indirections. */ #define dataToTagzh(r,a) r=(GET_TAG(((StgClosure *)a)->header.info)) +#endif + /* tagToEnum# is handled directly by the code generator. */ /* ----------------------------------------------------------------------------- @@ -890,4 +954,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 */