[project @ 2000-11-06 08:15:20 by simonpj]

[ghc-hetmet.git] / ghc / includes / PrimOps.h

diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h
index 1e14fd6..b76ba60 100644 (file)
--- a/ghc/includes/PrimOps.h
+++ b/ghc/includes/PrimOps.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.59 2000/07/21 09:11:19 rrt Exp $
+ * $Id: PrimOps.h,v 1.64 2000/10/12 15:49:34 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]
@@ -395,7 +431,6 @@ EXTFUN_RTS(divModIntegerzh_fast);
 /* Conversions */
 EXTFUN_RTS(int2Integerzh_fast);
 EXTFUN_RTS(word2Integerzh_fast);
-EXTFUN_RTS(addr2Integerzh_fast);
 
 /* Floating-point decodings */
 EXTFUN_RTS(decodeFloatzh_fast);
@@ -542,7 +577,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)
@@ -855,6 +891,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 +915,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. */
 
 /* -----------------------------------------------------------------------------