X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fincludes%2FPrimOps.h;h=cf467a4f428528dbe660c42a21a6a651649e66aa;hb=ea659be5faea43df1b2c113d2f22947dff23367e;hp=1e14fd69640fc0bc8f732cf41cbbd058dcc903d7;hpb=7753d428ece0d5ab97e6c04b5ce05e33107040ac;p=ghc-hetmet.git diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h index 1e14fd6..cf467a4 100644 --- a/ghc/includes/PrimOps.h +++ b/ghc/includes/PrimOps.h @@ -1,7 +1,7 @@ /* ----------------------------------------------------------------------------- - * $Id: PrimOps.h,v 1.59 2000/07/21 09:11:19 rrt Exp $ + * $Id: PrimOps.h,v 1.67 2000/11/13 14:40:36 simonmar Exp $ * - * (c) The GHC Team, 1998-1999 + * (c) The GHC Team, 1998-2000 * * Macros for primitive operations in STG-ish C code. * @@ -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] @@ -395,12 +431,17 @@ EXTFUN_RTS(divModIntegerzh_fast); /* Conversions */ EXTFUN_RTS(int2Integerzh_fast); EXTFUN_RTS(word2Integerzh_fast); -EXTFUN_RTS(addr2Integerzh_fast); /* Floating-point decodings */ 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. -------------------------------------------------------------------------- */ @@ -506,11 +547,11 @@ LI_ stg_word64ToInt64 (StgWord64); #ifdef DEBUG #define BYTE_ARR_CTS(a) \ - ({ ASSERT(GET_INFO((StgArrWords *)(a)) == &ARR_WORDS_info); \ + ({ ASSERT(GET_INFO((StgArrWords *)(a)) == &stg_ARR_WORDS_info); \ REAL_BYTE_ARR_CTS(a); }) #define PTRS_ARR_CTS(a) \ - ({ ASSERT((GET_INFO((StgMutArrPtrs *)(a)) == &MUT_ARR_PTRS_FROZEN_info) \ - || (GET_INFO((StgMutArrPtrs *)(a)) == &MUT_ARR_PTRS_info)); \ + ({ ASSERT((GET_INFO((StgMutArrPtrs *)(a)) == &stg_MUT_ARR_PTRS_FROZEN_info) \ + || (GET_INFO((StgMutArrPtrs *)(a)) == &stg_MUT_ARR_PTRS_info)); \ REAL_PTRS_ARR_CTS(a); }) #else #define BYTE_ARR_CTS(a) REAL_BYTE_ARR_CTS(a) @@ -542,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) @@ -577,7 +619,7 @@ extern I_ resetGenSymZh(void); #define unsafeFreezzeArrayzh(r,a) \ { \ - SET_INFO((StgClosure *)a,&MUT_ARR_PTRS_FROZEN_info); \ + SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN_info); \ r = a; \ } @@ -609,22 +651,15 @@ EXTFUN_RTS(newArrayzh_fast); /* The decode operations are out-of-line because they need to allocate * a byte array. */ -#ifdef FLOATS_AS_DOUBLES -#define decodeFloatzh_fast decodeDoublezh_fast -#else EXTFUN_RTS(decodeFloatzh_fast); -#endif - EXTFUN_RTS(decodeDoublezh_fast); /* grimy low-level support functions defined in StgPrimFloat.c */ extern StgDouble __encodeDouble (I_ size, StgByteArray arr, I_ e); extern StgDouble __int_encodeDouble (I_ j, I_ e); -#ifndef FLOATS_AS_DOUBLES extern StgFloat __encodeFloat (I_ size, StgByteArray arr, I_ e); extern StgFloat __int_encodeFloat (I_ j, I_ e); -#endif extern void __decodeDouble (MP_INT *man, I_ *_exp, StgDouble dbl); extern void __decodeFloat (MP_INT *man, I_ *_exp, StgFloat flt); extern StgInt isDoubleNaN(StgDouble d); @@ -656,7 +691,7 @@ EXTFUN_RTS(newMutVarzh_fast); #define sameMVarzh(r,a,b) r=(I_)((a)==(b)) /* 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 ) +#define isEmptyMVarzh(r,a) r=(I_)((GET_INFO((StgMVar*)(a))) == &stg_EMPTY_MVAR_info ) EXTFUN_RTS(newMVarzh_fast); EXTFUN_RTS(takeMVarzh_fast); EXTFUN_RTS(tryTakeMVarzh_fast); @@ -835,7 +870,7 @@ EXTFUN_RTS(mkWeakzh_fast); EXTFUN_RTS(finalizzeWeakzh_fast); #define deRefWeakzh(code,val,w) \ - if (((StgWeak *)w)->header.info == &WEAK_info) { \ + if (((StgWeak *)w)->header.info == &stg_WEAK_info) { \ code = 1; \ val = (P_)((StgWeak *)w)->value; \ } else { \ @@ -855,6 +890,9 @@ EXTFUN_RTS(finalizzeWeakzh_fast); #define ForeignObj_CLOSURE_DATA(c) (((StgForeignObj *)c)->data) +#define foreignObjToAddrzh(r,fo) r=ForeignObj_CLOSURE_DATA(fo) +#define touchzh(o) /* nothing */ + EXTFUN_RTS(mkForeignObjzh_fast); #define writeForeignObjzh(res,datum) \ @@ -876,11 +914,22 @@ EXTFUN_RTS(mkForeignObjzh_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. */ /* -----------------------------------------------------------------------------