/* -----------------------------------------------------------------------------
- * $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.
*
#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.
-------------------------------------------------------------------------- */
#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]
#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)
#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]
/* 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.
-------------------------------------------------------------------------- */
#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)
/* 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)
#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; \
}
/* 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);
#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);
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 { \
#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) \
#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. */
/* -----------------------------------------------------------------------------
projects / ghc-hetmet.git / blobdiff