[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 3565707..b76ba60 100644 (file)
--- a/ghc/includes/PrimOps.h
+++ b/ghc/includes/PrimOps.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.60 2000/08/07 23:37:23 qrczak 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.
    -------------------------------------------------------------------------- */
 
@@ -398,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);
@@ -859,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) \
@@ -880,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. */
 
 /* -----------------------------------------------------------------------------