/* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.64 2000/10/12 15:49:34 simonmar Exp $
+ * $Id: PrimOps.h,v 1.71 2001/01/03 16:44:29 sewardj 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.
+ Helpers for the bytecode linker.
-------------------------------------------------------------------------- */
-#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)
+#define addrToHValuezh(r,a) r=(P_)a
-#endif
/* -----------------------------------------------------------------------------
Comparison PrimOps.
#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]
+#define readInt8OffAddrzh(r,a,i) r= ((StgInt8 *)(a))[i]
+#define readInt16OffAddrzh(r,a,i) r= ((StgInt16 *)(a))[i]
+#define readInt32OffAddrzh(r,a,i) r= ((StgInt32 *)(a))[i]
+#define readWord8OffAddrzh(r,a,i) r= ((StgWord8 *)(a))[i]
+#define readWord16OffAddrzh(r,a,i) r= ((StgWord16 *)(a))[i]
+#define readWord32OffAddrzh(r,a,i) r= ((StgWord32 *)(a))[i]
#ifdef SUPPORT_LONG_LONGS
#define readInt64OffAddrzh(r,a,i) r= ((LI_ *)(a))[i]
#define readWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i]
#define writeFloatOffAddrzh(a,i,v) ASSIGN_FLT((P_) (((StgFloat *)(a)) + i),v)
#define writeDoubleOffAddrzh(a,i,v) ASSIGN_DBL((P_) (((StgDouble *)(a)) + i),v)
#define writeStablePtrOffAddrzh(a,i,v) ((StgStablePtr *)(a))[i] = (v)
+#define writeInt8OffAddrzh(a,i,v) ((StgInt8 *)(a))[i] = (v)
+#define writeInt16OffAddrzh(a,i,v) ((StgInt16 *)(a))[i] = (v)
+#define writeInt32OffAddrzh(a,i,v) ((StgInt32 *)(a))[i] = (v)
+#define writeWord8OffAddrzh(a,i,v) ((StgWord8 *)(a))[i] = (v)
+#define writeWord16OffAddrzh(a,i,v) ((StgWord16 *)(a))[i] = (v)
+#define writeWord32OffAddrzh(a,i,v) ((StgWord32 *)(a))[i] = (v)
#ifdef SUPPORT_LONG_LONGS
#define writeInt64OffAddrzh(a,i,v) ((LI_ *)(a))[i] = (v)
#define writeWord64OffAddrzh(a,i,v) ((LW_ *)(a))[i] = (v)
#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 indexInt8OffAddrzh(r,a,i) r= ((StgInt8 *)(a))[i]
+#define indexInt16OffAddrzh(r,a,i) r= ((StgInt16 *)(a))[i]
+#define indexInt32OffAddrzh(r,a,i) r= ((StgInt32 *)(a))[i]
+#define indexWord8OffAddrzh(r,a,i) r= ((StgWord8 *)(a))[i]
+#define indexWord16OffAddrzh(r,a,i) r= ((StgWord16 *)(a))[i]
+#define indexWord32OffAddrzh(r,a,i) r= ((StgWord32 *)(a))[i]
#ifdef SUPPORT_LONG_LONGS
#define indexInt64OffAddrzh(r,a,i) r= ((LI_ *)(a))[i]
#define indexWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i]
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)
#define readFloatArrayzh(r,a,i) indexFloatOffAddrzh(r,BYTE_ARR_CTS(a),i)
#define readDoubleArrayzh(r,a,i) indexDoubleOffAddrzh(r,BYTE_ARR_CTS(a),i)
#define readStablePtrArrayzh(r,a,i) indexStablePtrOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readInt8Arrayzh(r,a,i) indexInt8OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readInt16Arrayzh(r,a,i) indexInt16OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readInt32Arrayzh(r,a,i) indexInt32OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readWord8Arrayzh(r,a,i) indexWord8OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readWord16Arrayzh(r,a,i) indexWord16OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readWord32Arrayzh(r,a,i) indexWord32OffAddrzh(r,BYTE_ARR_CTS(a),i)
#ifdef SUPPORT_LONG_LONGS
#define readInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i)
#define readWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i)
#define writeDoubleArrayzh(a,i,v) \
ASSIGN_DBL((P_) (((StgDouble *)(BYTE_ARR_CTS(a))) + i),v)
#define writeStablePtrArrayzh(a,i,v) ((StgStablePtr *)(BYTE_ARR_CTS(a)))[i] = (v)
+#define writeInt8Arrayzh(a,i,v) ((StgInt8 *)(BYTE_ARR_CTS(a)))[i] = (v)
+#define writeInt16Arrayzh(a,i,v) ((StgInt16 *)(BYTE_ARR_CTS(a)))[i] = (v)
+#define writeInt32Arrayzh(a,i,v) ((StgInt32 *)(BYTE_ARR_CTS(a)))[i] = (v)
+#define writeWord8Arrayzh(a,i,v) ((StgWord8 *)(BYTE_ARR_CTS(a)))[i] = (v)
+#define writeWord16Arrayzh(a,i,v) ((StgWord16 *)(BYTE_ARR_CTS(a)))[i] = (v)
+#define writeWord32Arrayzh(a,i,v) ((StgWord32 *)(BYTE_ARR_CTS(a)))[i] = (v)
#ifdef SUPPORT_LONG_LONGS
#define writeInt64Arrayzh(a,i,v) ((LI_ *)(BYTE_ARR_CTS(a)))[i] = (v)
#define writeWord64Arrayzh(a,i,v) ((LW_ *)(BYTE_ARR_CTS(a)))[i] = (v)
#define indexFloatArrayzh(r,a,i) indexFloatOffAddrzh(r,BYTE_ARR_CTS(a),i)
#define indexDoubleArrayzh(r,a,i) indexDoubleOffAddrzh(r,BYTE_ARR_CTS(a),i)
#define indexStablePtrArrayzh(r,a,i) indexStablePtrOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexInt8Arrayzh(r,a,i) indexInt8OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexInt16Arrayzh(r,a,i) indexInt16OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexInt32Arrayzh(r,a,i) indexInt32OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexWord8Arrayzh(r,a,i) indexWord8OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexWord16Arrayzh(r,a,i) indexWord16OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexWord32Arrayzh(r,a,i) indexWord32OffAddrzh(r,BYTE_ARR_CTS(a),i)
#ifdef SUPPORT_LONG_LONGS
#define indexInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i)
#define indexWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i)
#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; \
}
/* and the out-of-line ones... */
-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(newByteArrayzh_fast);
EXTFUN_RTS(newArrayzh_fast);
/* encoding and decoding of floats/doubles. */
/* 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 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)
+#define indexInt8OffForeignObjzh(r,fo,i) indexInt8OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexInt16OffForeignObjzh(r,fo,i) indexInt16OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexInt32OffForeignObjzh(r,fo,i) indexInt32OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexWord8OffForeignObjzh(r,fo,i) indexWord8OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexWord16OffForeignObjzh(r,fo,i) indexWord16OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexWord32OffForeignObjzh(r,fo,i) indexWord32OffAddrzh(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)
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. */
/* -----------------------------------------------------------------------------
+ BCOs
+ -------------------------------------------------------------------------- */
+
+EXTFUN_RTS(newBCOzh_fast);
+
+/* -----------------------------------------------------------------------------
Signal processing. Not really primops, but called directly from
Haskell.
-------------------------------------------------------------------------- */
projects / ghc-hetmet.git / blobdiff