[project @ 1999-05-10 09:50:49 by simonm]
[ghc-hetmet.git] / ghc / includes / PrimOps.h
index ef1a19f..87630c4 100644 (file)
@@ -1,5 +1,7 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.2 1998/12/02 13:21:18 simonm Exp $
+ * $Id: PrimOps.h,v 1.30 1999/05/10 09:50:49 simonm Exp $
+ *
+ * (c) The GHC Team, 1998-1999
  *
  * Macros for primitive operations in STG-ish C code.
  *
    Comparison PrimOps.
    -------------------------------------------------------------------------- */
 
-#define gtCharZh(r,a,b)        r=(I_)((a)> (b))
-#define geCharZh(r,a,b)        r=(I_)((a)>=(b))
-#define eqCharZh(r,a,b)        r=(I_)((a)==(b))
-#define neCharZh(r,a,b)        r=(I_)((a)!=(b))
-#define ltCharZh(r,a,b)        r=(I_)((a)< (b))
-#define leCharZh(r,a,b)        r=(I_)((a)<=(b))
+#define gtCharzh(r,a,b)        r=(I_)((a)> (b))
+#define geCharzh(r,a,b)        r=(I_)((a)>=(b))
+#define eqCharzh(r,a,b)        r=(I_)((a)==(b))
+#define neCharzh(r,a,b)        r=(I_)((a)!=(b))
+#define ltCharzh(r,a,b)        r=(I_)((a)< (b))
+#define leCharzh(r,a,b)        r=(I_)((a)<=(b))
 
 /* Int comparisons: >#, >=# etc */
-#define ZgZh(r,a,b)    r=(I_)((a) >(b))
-#define ZgZeZh(r,a,b)  r=(I_)((a)>=(b))
-#define ZeZeZh(r,a,b)  r=(I_)((a)==(b))
-#define ZdZeZh(r,a,b)  r=(I_)((a)!=(b))
-#define ZlZh(r,a,b)    r=(I_)((a) <(b))
-#define ZlZeZh(r,a,b)  r=(I_)((a)<=(b))
-
-#define gtWordZh(r,a,b)        r=(I_)((a) >(b))
-#define geWordZh(r,a,b)        r=(I_)((a)>=(b))
-#define eqWordZh(r,a,b)        r=(I_)((a)==(b))
-#define neWordZh(r,a,b)        r=(I_)((a)!=(b))
-#define ltWordZh(r,a,b)        r=(I_)((a) <(b))
-#define leWordZh(r,a,b)        r=(I_)((a)<=(b))
-
-#define gtAddrZh(r,a,b)        r=(I_)((a) >(b))
-#define geAddrZh(r,a,b)        r=(I_)((a)>=(b))
-#define eqAddrZh(r,a,b)        r=(I_)((a)==(b))
-#define neAddrZh(r,a,b)        r=(I_)((a)!=(b))
-#define ltAddrZh(r,a,b)        r=(I_)((a) <(b))
-#define leAddrZh(r,a,b)        r=(I_)((a)<=(b))
-
-#define gtFloatZh(r,a,b)  r=(I_)((a)> (b))
-#define geFloatZh(r,a,b)  r=(I_)((a)>=(b))
-#define eqFloatZh(r,a,b)  r=(I_)((a)==(b))
-#define neFloatZh(r,a,b)  r=(I_)((a)!=(b))
-#define ltFloatZh(r,a,b)  r=(I_)((a)< (b))
-#define leFloatZh(r,a,b)  r=(I_)((a)<=(b))
+#define zgzh(r,a,b)    r=(I_)((I_)(a) >(I_)(b))
+#define zgzezh(r,a,b)  r=(I_)((I_)(a)>=(I_)(b))
+#define zezezh(r,a,b)  r=(I_)((I_)(a)==(I_)(b))
+#define zszezh(r,a,b)  r=(I_)((I_)(a)!=(I_)(b))
+#define zlzh(r,a,b)    r=(I_)((I_)(a) <(I_)(b))
+#define zlzezh(r,a,b)  r=(I_)((I_)(a)<=(I_)(b))
+
+#define gtWordzh(r,a,b)        r=(I_)((W_)(a) >(W_)(b))
+#define geWordzh(r,a,b)        r=(I_)((W_)(a)>=(W_)(b))
+#define eqWordzh(r,a,b)        r=(I_)((W_)(a)==(W_)(b))
+#define neWordzh(r,a,b)        r=(I_)((W_)(a)!=(W_)(b))
+#define ltWordzh(r,a,b)        r=(I_)((W_)(a) <(W_)(b))
+#define leWordzh(r,a,b)        r=(I_)((W_)(a)<=(W_)(b))
+
+#define gtAddrzh(r,a,b)        r=(I_)((a) >(b))
+#define geAddrzh(r,a,b)        r=(I_)((a)>=(b))
+#define eqAddrzh(r,a,b)        r=(I_)((a)==(b))
+#define neAddrzh(r,a,b)        r=(I_)((a)!=(b))
+#define ltAddrzh(r,a,b)        r=(I_)((a) <(b))
+#define leAddrzh(r,a,b)        r=(I_)((a)<=(b))
+
+#define gtFloatzh(r,a,b)  r=(I_)((a)> (b))
+#define geFloatzh(r,a,b)  r=(I_)((a)>=(b))
+#define eqFloatzh(r,a,b)  r=(I_)((a)==(b))
+#define neFloatzh(r,a,b)  r=(I_)((a)!=(b))
+#define ltFloatzh(r,a,b)  r=(I_)((a)< (b))
+#define leFloatzh(r,a,b)  r=(I_)((a)<=(b))
 
 /* Double comparisons: >##, >=#@ etc */
-#define ZgZhZh(r,a,b)  r=(I_)((a) >(b))
-#define ZgZeZhZh(r,a,b)        r=(I_)((a)>=(b))
-#define ZeZeZhZh(r,a,b)        r=(I_)((a)==(b))
-#define ZdZeZhZh(r,a,b)        r=(I_)((a)!=(b))
-#define ZlZhZh(r,a,b)  r=(I_)((a) <(b))
-#define ZlZeZhZh(r,a,b)        r=(I_)((a)<=(b))
-
-/*  used by returning comparison primops, defined in Prims.hc. */
-extern const StgClosure *PrelBase_Bool_closure_tbl[];
+#define zgzhzh(r,a,b)  r=(I_)((a) >(b))
+#define zgzezhzh(r,a,b)        r=(I_)((a)>=(b))
+#define zezezhzh(r,a,b)        r=(I_)((a)==(b))
+#define zszezhzh(r,a,b)        r=(I_)((a)!=(b))
+#define zlzhzh(r,a,b)  r=(I_)((a) <(b))
+#define zlzezhzh(r,a,b)        r=(I_)((a)<=(b))
 
 /* -----------------------------------------------------------------------------
    Char# PrimOps.
    -------------------------------------------------------------------------- */
 
-#define ordZh(r,a)     r=(I_)((W_) (a))
-#define chrZh(r,a)     r=(StgChar)((W_)(a))
+#define ordzh(r,a)     r=(I_)((W_) (a))
+#define chrzh(r,a)     r=(StgChar)((W_)(a))
 
 /* -----------------------------------------------------------------------------
    Int# PrimOps.
@@ -72,22 +71,71 @@ extern const StgClosure *PrelBase_Bool_closure_tbl[];
 
 I_ stg_div (I_ a, I_ b);
 
-#define ZpZh(r,a,b)            r=(a)+(b)
-#define ZmZh(r,a,b)            r=(a)-(b)
-#define ZtZh(r,a,b)            r=(a)*(b)
-#define quotIntZh(r,a,b)       r=(a)/(b)
-#define ZdZh(r,a,b)            r=ULTRASAFESTGCALL2(I_,(void *, I_, I_),stg_div,(a),(b))
-#define remIntZh(r,a,b)                r=(a)%(b)
-#define negateIntZh(r,a)       r=-(a)
+#define zpzh(r,a,b)            r=(a)+(b)
+#define zmzh(r,a,b)            r=(a)-(b)
+#define ztzh(r,a,b)            r=(a)*(b)
+#define quotIntzh(r,a,b)       r=(a)/(b)
+#define zszh(r,a,b)            r=ULTRASAFESTGCALL2(I_,(void *, I_, I_),stg_div,(a),(b))
+#define remIntzh(r,a,b)                r=(a)%(b)
+#define negateIntzh(r,a)       r=-(a)
+
+/* -----------------------------------------------------------------------------
+ * Int operations with carry.
+ * -------------------------------------------------------------------------- */
 
-/* The following operations are the standard add,subtract and multiply
- * except that they return a carry if the operation overflows.
+/* With some bit-twiddling, we can define int{Add,Sub}Czh portably in
+ * C, and without needing any comparisons.  This may not be the
+ * fastest way to do it - if you have better code, please send it! --SDM
  *
- * They are all defined in terms of 32-bit integers and use the GCC
- * 'long long' extension to get a 64-bit result.  We'd like to use
- * 64-bit integers on 64-bit architectures, but it seems that gcc's
- * 'long long' type is set at 64-bits even on a 64-bit machine.  
+ * Return : r = a + b,  c = 0 if no overflow, 1 on overflow.
+ *
+ * We currently don't make use of the r value if c is != 0 (i.e. 
+ * overflow), we just convert to big integers and try again.  This
+ * could be improved by making r and c the correct values for
+ * plugging into a new J#.  
  */
+#define addIntCzh(r,c,a,b)                     \
+{ r = a + b;                                   \
+  c = ((StgWord)(~(a^b) & (a^r)))              \
+    >> (BITS_PER_BYTE * sizeof(I_) - 1);       \
+}
+
+
+#define subIntCzh(r,c,a,b)                     \
+{ r = a - b;                                   \
+  c = ((StgWord)((a^b) & (a^r)))               \
+    >> (BITS_PER_BYTE * sizeof(I_) - 1);       \
+}
+
+/* Multiply with overflow checking.
+ *
+ * This is slightly more tricky - the usual sign rules for add/subtract
+ * don't apply.  
+ *
+ * On x86 hardware we use a hand-crafted assembly fragment to do the job.
+ *
+ * On other 32-bit machines we use gcc's 'long long' types, finding
+ * overflow with some careful bit-twiddling.
+ *
+ * On 64-bit machines where gcc's 'long long' type is also 64-bits,
+ * we use a crude approximation, testing whether either operand is
+ * larger than 32-bits; if neither is, then we go ahead with the
+ * multiplication.
+ */
+
+#if i386_TARGET_ARCH
+
+#define mulIntCzh(r,c,a,b)                             \
+{                                                      \
+  __asm__("xor %1,%1\n\t                               \
+          imull %2,%3\n\t                              \
+          jno 1f\n\t                                   \
+          movl $1,%1\n\t                               \
+          1:"                                          \
+       : "=r" (r), "=r" (c) : "r" (a), "0" (b));       \
+}
+
+#elif SIZEOF_VOID_P == 4
 
 #ifdef WORDS_BIGENDIAN
 #define C 0
@@ -102,140 +150,152 @@ typedef union {
     StgInt32 i[2];
 } long_long_u ;
 
-#define addWithCarryZh(r,c,a,b)                        \
-{ long_long_u z;                               \
-  z.l = a + b;                                 \
+#define mulIntCzh(r,c,a,b)                     \
+{                                              \
+  long_long_u z;                               \
+  z.l = (StgInt64)a * (StgInt64)b;             \
   r = z.i[R];                                  \
   c = z.i[C];                                  \
+  if (c == 0 || c == -1) {                     \
+    c = ((StgWord)((a^b) ^ r))                 \
+      >> (BITS_PER_BYTE * sizeof(I_) - 1);     \
+  }                                            \
 }
+/* Careful: the carry calculation above is extremely delicate.  Make sure
+ * you test it thoroughly after changing it.
+ */
 
-#define subWithCarryZh(r,c,a,b)                        \
-{ long_long_u z;                               \
-  z.l = a + b;                                 \
-  r = z.i[R];                                  \
-  c = z.i[C];                                  \
-}
+#else
 
-#define mulWithCarryZh(r,c,a,b)                        \
-{ long_long_u z;                               \
-  z.l = a * b;                                 \
-  r = z.i[R];                                  \
-  c = z.i[C];                                  \
+#define HALF_INT  (1 << (BITS_PER_BYTE * sizeof(I_) / 2))
+
+#define stg_abs(a) ((a) < 0 ? -(a) : (a))
+
+#define mulIntCzh(r,c,a,b)                     \
+{                                              \
+  if (stg_abs(a) >= HALF_INT                   \
+      stg_abs(b) >= HALF_INT) {                        \
+    c = 1;                                     \
+  } else {                                     \
+    r = a * b;                                 \
+    c = 0;                                     \
+  }                                            \
 }
+#endif
 
 /* -----------------------------------------------------------------------------
    Word PrimOps.
    -------------------------------------------------------------------------- */
 
-#define quotWordZh(r,a,b)      r=((W_)a)/((W_)b)
-#define remWordZh(r,a,b)       r=((W_)a)%((W_)b)
+#define quotWordzh(r,a,b)      r=((W_)a)/((W_)b)
+#define remWordzh(r,a,b)       r=((W_)a)%((W_)b)
 
-#define andZh(r,a,b)           r=(a)&(b)
-#define orZh(r,a,b)            r=(a)|(b)
-#define xorZh(r,a,b)            r=(a)^(b)
-#define notZh(r,a)             r=~(a)
+#define andzh(r,a,b)           r=(a)&(b)
+#define orzh(r,a,b)            r=(a)|(b)
+#define xorzh(r,a,b)            r=(a)^(b)
+#define notzh(r,a)             r=~(a)
 
-#define shiftLZh(r,a,b)                r=(a)<<(b)
-#define shiftRLZh(r,a,b)       r=(a)>>(b)
-#define iShiftLZh(r,a,b)       r=(a)<<(b)
+#define shiftLzh(r,a,b)                r=(a)<<(b)
+#define shiftRLzh(r,a,b)       r=(a)>>(b)
+#define iShiftLzh(r,a,b)       r=(a)<<(b)
 /* Right shifting of signed quantities is not portable in C, so
    the behaviour you'll get from using these primops depends
    on the whatever your C compiler is doing. ToDo: fix/document. -- sof 8/98
 */
-#define iShiftRAZh(r,a,b)      r=(a)>>(b)
-#define iShiftRLZh(r,a,b)      r=(a)>>(b)
+#define iShiftRAzh(r,a,b)      r=(a)>>(b)
+#define iShiftRLzh(r,a,b)      r=(a)>>(b)
 
-#define int2WordZh(r,a)        r=(W_)(a)
-#define word2IntZh(r,a)        r=(I_)(a)
+#define int2Wordzh(r,a)        r=(W_)(a)
+#define word2Intzh(r,a)        r=(I_)(a)
 
 /* -----------------------------------------------------------------------------
    Addr PrimOps.
    -------------------------------------------------------------------------- */
 
-#define int2AddrZh(r,a)        r=(A_)(a)
-#define addr2IntZh(r,a)        r=(I_)(a)
+#define int2Addrzh(r,a)        r=(A_)(a)
+#define addr2Intzh(r,a)        r=(I_)(a)
 
-#define indexCharOffAddrZh(r,a,i)   r= ((C_ *)(a))[i]
-#define indexIntOffAddrZh(r,a,i)    r= ((I_ *)(a))[i]
-#define indexAddrOffAddrZh(r,a,i)   r= ((PP_)(a))[i]
-#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 indexCharOffAddrzh(r,a,i)   r= ((C_ *)(a))[i]
+#define indexIntOffAddrzh(r,a,i)    r= ((I_ *)(a))[i]
+#define indexAddrOffAddrzh(r,a,i)   r= ((PP_)(a))[i]
+#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]
 #ifdef SUPPORT_LONG_LONGS
-#define indexInt64OffAddrZh(r,a,i)  r= ((LI_ *)(a))[i]
-#define indexWord64OffAddrZh(r,a,i) r= ((LW_ *)(a))[i]
+#define indexInt64OffAddrzh(r,a,i)  r= ((LI_ *)(a))[i]
+#define indexWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i]
 #endif
 
-#define writeCharOffAddrZh(a,i,v)       ((C_ *)(a))[i] = (v)
-#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 writeForeignObjOffAddrZh(a,i,v) ((PP_)(a))[i] = ForeignObj_CLOSURE_DATA(v)
-#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 writeCharOffAddrzh(a,i,v)       ((C_ *)(a))[i] = (v)
+#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 writeForeignObjOffAddrzh(a,i,v) ((PP_)(a))[i] = ForeignObj_CLOSURE_DATA(v)
+#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)
 #ifdef SUPPORT_LONG_LONGS
-#define writeInt64OffAddrZh(a,i,v)   ((LI_ *)(a))[i] = (v)
-#define writeWord64OffAddrZh(a,i,v)  ((LW_ *)(a))[i] = (v)
+#define writeInt64OffAddrzh(a,i,v)   ((LI_ *)(a))[i] = (v)
+#define writeWord64OffAddrzh(a,i,v)  ((LW_ *)(a))[i] = (v)
 #endif
 
 /* -----------------------------------------------------------------------------
    Float PrimOps.
    -------------------------------------------------------------------------- */
 
-#define plusFloatZh(r,a,b)   r=(a)+(b)
-#define minusFloatZh(r,a,b)  r=(a)-(b)
-#define timesFloatZh(r,a,b)  r=(a)*(b)
-#define divideFloatZh(r,a,b) r=(a)/(b)
-#define negateFloatZh(r,a)   r=-(a)
+#define plusFloatzh(r,a,b)   r=(a)+(b)
+#define minusFloatzh(r,a,b)  r=(a)-(b)
+#define timesFloatzh(r,a,b)  r=(a)*(b)
+#define divideFloatzh(r,a,b) r=(a)/(b)
+#define negateFloatzh(r,a)   r=-(a)
                             
-#define int2FloatZh(r,a)     r=(StgFloat)(a)
-#define float2IntZh(r,a)     r=(I_)(a)
+#define int2Floatzh(r,a)     r=(StgFloat)(a)
+#define float2Intzh(r,a)     r=(I_)(a)
                             
-#define expFloatZh(r,a)             r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,exp,a)
-#define logFloatZh(r,a)             r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,log,a)
-#define sqrtFloatZh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sqrt,a)
-#define sinFloatZh(r,a)             r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sin,a)
-#define cosFloatZh(r,a)             r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,cos,a)
-#define tanFloatZh(r,a)             r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,tan,a)
-#define asinFloatZh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,asin,a)
-#define acosFloatZh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,acos,a)
-#define atanFloatZh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,atan,a)
-#define sinhFloatZh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sinh,a)
-#define coshFloatZh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,cosh,a)
-#define tanhFloatZh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,tanh,a)
-#define powerFloatZh(r,a,b)  r=(StgFloat) RET_PRIM_STGCALL2(StgDouble,pow,a,b)
+#define expFloatzh(r,a)             r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,exp,a)
+#define logFloatzh(r,a)             r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,log,a)
+#define sqrtFloatzh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sqrt,a)
+#define sinFloatzh(r,a)             r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sin,a)
+#define cosFloatzh(r,a)             r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,cos,a)
+#define tanFloatzh(r,a)             r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,tan,a)
+#define asinFloatzh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,asin,a)
+#define acosFloatzh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,acos,a)
+#define atanFloatzh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,atan,a)
+#define sinhFloatzh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,sinh,a)
+#define coshFloatzh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,cosh,a)
+#define tanhFloatzh(r,a)     r=(StgFloat) RET_PRIM_STGCALL1(StgDouble,tanh,a)
+#define powerFloatzh(r,a,b)  r=(StgFloat) RET_PRIM_STGCALL2(StgDouble,pow,a,b)
 
 /* -----------------------------------------------------------------------------
    Double PrimOps.
    -------------------------------------------------------------------------- */
 
-#define ZpZhZh(r,a,b)       r=(a)+(b)
-#define ZmZhZh(r,a,b)       r=(a)-(b)
-#define ZtZhZh(r,a,b)       r=(a)*(b)
-#define ZdZhZh(r,a,b)       r=(a)/(b)
-#define negateDoubleZh(r,a)  r=-(a)
+#define zpzhzh(r,a,b)       r=(a)+(b)
+#define zmzhzh(r,a,b)       r=(a)-(b)
+#define ztzhzh(r,a,b)       r=(a)*(b)
+#define zszhzh(r,a,b)       r=(a)/(b)
+#define negateDoublezh(r,a)  r=-(a)
                             
-#define int2DoubleZh(r,a)    r=(StgDouble)(a)
-#define double2IntZh(r,a)    r=(I_)(a)
+#define int2Doublezh(r,a)    r=(StgDouble)(a)
+#define double2Intzh(r,a)    r=(I_)(a)
                             
-#define float2DoubleZh(r,a)  r=(StgDouble)(a)
-#define double2FloatZh(r,a)  r=(StgFloat)(a)
+#define float2Doublezh(r,a)  r=(StgDouble)(a)
+#define double2Floatzh(r,a)  r=(StgFloat)(a)
                             
-#define expDoubleZh(r,a)     r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,exp,a)
-#define logDoubleZh(r,a)     r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,log,a)
-#define sqrtDoubleZh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sqrt,a)
-#define sinDoubleZh(r,a)     r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sin,a)
-#define cosDoubleZh(r,a)     r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,cos,a)
-#define tanDoubleZh(r,a)     r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,tan,a)
-#define asinDoubleZh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,asin,a)
-#define acosDoubleZh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,acos,a)
-#define atanDoubleZh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,atan,a)
-#define sinhDoubleZh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sinh,a)
-#define coshDoubleZh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,cosh,a)
-#define tanhDoubleZh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,tanh,a)
+#define expDoublezh(r,a)     r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,exp,a)
+#define logDoublezh(r,a)     r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,log,a)
+#define sqrtDoublezh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sqrt,a)
+#define sinDoublezh(r,a)     r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sin,a)
+#define cosDoublezh(r,a)     r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,cos,a)
+#define tanDoublezh(r,a)     r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,tan,a)
+#define asinDoublezh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,asin,a)
+#define acosDoublezh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,acos,a)
+#define atanDoublezh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,atan,a)
+#define sinhDoublezh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,sinh,a)
+#define coshDoublezh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,cosh,a)
+#define tanhDoublezh(r,a)    r=(StgDouble) RET_PRIM_STGCALL1(StgDouble,tanh,a)
 /* Power: **## */
-#define ZtZtZhZh(r,a,b)        r=(StgDouble) RET_PRIM_STGCALL2(StgDouble,pow,a,b)
+#define ztztzhzh(r,a,b)        r=(StgDouble) RET_PRIM_STGCALL2(StgDouble,pow,a,b)
 
 /* -----------------------------------------------------------------------------
    Integer PrimOps.
@@ -243,75 +303,74 @@ typedef union {
 
 /* We can do integer2Int and cmpInteger inline, since they don't need
  * to allocate any memory.
+ *
+ * integer2Int# is now modular.
  */
 
-#define integer2IntZh(r, aa,sa,da)                                     \
-{ MP_INT arg;                                                          \
-                                                                       \
-  arg._mp_alloc        = (aa);                                                 \
-  arg._mp_size = (sa);                                                 \
-  arg._mp_d    = (unsigned long int *) (BYTE_ARR_CTS(da));             \
-                                                                       \
-  (r) = RET_PRIM_STGCALL1(I_,mpz_get_si,&arg);                         \
+#define integer2Intzh(r, sa,da)                                \
+{ StgWord word0 = ((StgWord *)BYTE_ARR_CTS(da))[0];    \
+  int size = sa;                                       \
+                                                       \
+  (r) =                                                        \
+    ( size == 0 ) ?                                    \
+       0 :                                             \
+       ( size < 0 && word0 != 0x8000000 ) ?            \
+         -(I_)word0 :                                  \
+         (I_)word0;                                    \
 }
 
-#define integer2WordZh(r, aa,sa,da)                                    \
-{ MP_INT arg;                                                          \
-                                                                       \
-  arg._mp_alloc        = (aa);                                                 \
-  arg._mp_size = (sa);                                                 \
-  arg._mp_d    = (unsigned long int *) (BYTE_ARR_CTS(da));             \
-                                                                       \
-  (r) = RET_PRIM_STGCALL1(I_,mpz_get_ui,&arg);                         \
+#define integer2Wordzh(r, sa,da)                               \
+{ MP_INT arg;                                                  \
+                                                               \
+  arg._mp_size = (sa);                                         \
+  arg._mp_alloc        = ((StgArrWords *)da)->words;                   \
+  arg._mp_d    = (unsigned long int *) (BYTE_ARR_CTS(da));     \
+                                                               \
+  (r) = RET_PRIM_STGCALL1(I_,mpz_get_ui,&arg);                 \
 }
 
-#define cmpIntegerZh(r, a1,s1,d1, a2,s2,d2)                            \
-{ MP_INT arg1;                                                         \
-  MP_INT arg2;                                                         \
-                                                                       \
-  arg1._mp_alloc= (a1);                                                        \
-  arg1._mp_size        = (s1);                                                 \
-  arg1._mp_d   = (unsigned long int *) (BYTE_ARR_CTS(d1));             \
-  arg2._mp_alloc= (a2);                                                        \
-  arg2._mp_size        = (s2);                                                 \
-  arg2._mp_d   = (unsigned long int *) (BYTE_ARR_CTS(d2));             \
-                                                                       \
-  (r) = RET_PRIM_STGCALL2(I_,mpz_cmp,&arg1,&arg2);                             \
+#define cmpIntegerzh(r, s1,d1, s2,d2)                          \
+{ MP_INT arg1;                                                 \
+  MP_INT arg2;                                                 \
+                                                               \
+  arg1._mp_size        = (s1);                                         \
+  arg1._mp_alloc= ((StgArrWords *)d1)->words;                  \
+  arg1._mp_d   = (unsigned long int *) (BYTE_ARR_CTS(d1));     \
+  arg2._mp_size        = (s2);                                         \
+  arg2._mp_alloc= ((StgArrWords *)d2)->words;                  \
+  arg2._mp_d   = (unsigned long int *) (BYTE_ARR_CTS(d2));     \
+                                                               \
+  (r) = RET_PRIM_STGCALL2(I_,mpz_cmp,&arg1,&arg2);             \
 }
 
-/* A glorious hack: calling mpz_neg would entail allocation and
- * copying, but by looking at what mpz_neg actually does, we can
- * derive a better version:
- */
-
-#define negateIntegerZh(ra, rs, rd, a, s, d)                           \
-{                                                                      \
-  (ra) = (a);                                                          \
-  (rs) = -(s);                                                         \
-  (rd) = d;                                                            \
+#define cmpIntegerIntzh(r, s,d, i)                             \
+{ MP_INT arg;                                                  \
+                                                               \
+  arg._mp_size = (s);                                          \
+  arg._mp_alloc = ((StgArrWords *)d)->words;                   \
+  arg._mp_d    = (unsigned long int *) (BYTE_ARR_CTS(d));      \
+                                                               \
+  (r) = RET_PRIM_STGCALL2(I_,mpz_cmp_si,&arg,i);               \
 }
 
 /* The rest are all out-of-line: -------- */
 
 /* Integer arithmetic */
-EF_(plusIntegerZh_fast);
-EF_(minusIntegerZh_fast);
-EF_(timesIntegerZh_fast);
-EF_(gcdIntegerZh_fast);
-EF_(quotRemIntegerZh_fast);
-EF_(divModIntegerZh_fast);
+EF_(plusIntegerzh_fast);
+EF_(minusIntegerzh_fast);
+EF_(timesIntegerzh_fast);
+EF_(gcdIntegerzh_fast);
+EF_(quotRemIntegerzh_fast);
+EF_(divModIntegerzh_fast);
 
 /* Conversions */
-EF_(int2IntegerZh_fast);
-EF_(word2IntegerZh_fast);
-EF_(addr2IntegerZh_fast);
-
-/* Floating-point encodings/decodings */
-EF_(encodeFloatZh_fast);
-EF_(decodeFloatZh_fast);
+EF_(int2Integerzh_fast);
+EF_(word2Integerzh_fast);
+EF_(addr2Integerzh_fast);
 
-EF_(encodeDoubleZh_fast);
-EF_(decodeDoubleZh_fast);
+/* Floating-point decodings */
+EF_(decodeFloatzh_fast);
+EF_(decodeDoublezh_fast);
 
 /* -----------------------------------------------------------------------------
    Word64 PrimOps.
@@ -319,48 +378,55 @@ EF_(decodeDoubleZh_fast);
 
 #ifdef SUPPORT_LONG_LONGS
 
-#define integerToWord64Zh(r, aa,sa,da)                                 \
-{ unsigned long int* d;                                                \
-  StgNat64 res;                                                                \
-                                                                       \
-  d            = (unsigned long int *) (BYTE_ARR_CTS(da));             \
-  if ( (aa) == 0 ) {                                                   \
-     res = (LW_)0;                                                     \
-  } else if ( (aa) == 1) {                                             \
-     res = (LW_)d[0];                                                  \
-  } else {                                                             \
-     res = (LW_)d[0] + (LW_)d[1] * 0x100000000ULL;                     \
-  }                                                                    \
-  (r) = res;                                                           \
+#define integerToWord64zh(r, sa,da)                            \
+{ unsigned long int* d;                                                \
+  I_ aa;                                                       \
+  StgWord64 res;                                               \
+                                                               \
+  d            = (unsigned long int *) (BYTE_ARR_CTS(da));     \
+  aa = ((StgArrWords *)da)->words;                             \
+  if ( (aa) == 0 ) {                                           \
+     res = (LW_)0;                                             \
+  } else if ( (aa) == 1) {                                     \
+     res = (LW_)d[0];                                          \
+  } else {                                                     \
+     res = (LW_)d[0] + (LW_)d[1] * 0x100000000ULL;             \
+  }                                                            \
+  (r) = res;                                                   \
 }
 
-#define integerToInt64Zh(r, aa,sa,da)                                  \
-{ unsigned long int* d;                                                \
-  StgInt64 res;                                                                \
-                                                                       \
-  d            = (unsigned long int *) (BYTE_ARR_CTS(da));             \
-  if ( (aa) == 0 ) {                                                   \
-     res = (LI_)0;                                                     \
-  } else if ( (aa) == 1) {                                             \
-     res = (LI_)d[0];                                                  \
-  } else {                                                             \
-     res = (LI_)d[0] + (LI_)d[1] * 0x100000000LL;                      \
-  }                                                                    \
-  (r) = res;                                                           \
+#define integerToInt64zh(r, sa,da)                             \
+{ unsigned long int* d;                                                \
+  I_ aa;                                                       \
+  StgInt64 res;                                                        \
+                                                               \
+  d            = (unsigned long int *) (BYTE_ARR_CTS(da));     \
+  aa = ((StgArrWords *)da)->words;                             \
+  if ( (aa) == 0 ) {                                           \
+     res = (LI_)0;                                             \
+  } else if ( (aa) == 1) {                                     \
+     res = (LI_)d[0];                                          \
+  } else {                                                     \
+     res = (LI_)d[0] + (LI_)d[1] * 0x100000000LL;              \
+     if ( sa < 0 ) {                                           \
+          res = (LI_)-res;                                     \
+     }                                                         \
+  }                                                            \
+  (r) = res;                                                   \
 }
 
 /* Conversions */
-EF_(int64ToIntegerZh_fast);
-EF_(word64ToIntegerZh_fast);
+EF_(int64ToIntegerzh_fast);
+EF_(word64ToIntegerzh_fast);
 
 /* The rest are (way!) out of line, implemented via C entry points.
  */
-I_ stg_gtWord64 (StgNat64, StgNat64);
-I_ stg_geWord64 (StgNat64, StgNat64);
-I_ stg_eqWord64 (StgNat64, StgNat64);
-I_ stg_neWord64 (StgNat64, StgNat64);
-I_ stg_ltWord64 (StgNat64, StgNat64);
-I_ stg_leWord64 (StgNat64, StgNat64);
+I_ stg_gtWord64 (StgWord64, StgWord64);
+I_ stg_geWord64 (StgWord64, StgWord64);
+I_ stg_eqWord64 (StgWord64, StgWord64);
+I_ stg_neWord64 (StgWord64, StgWord64);
+I_ stg_ltWord64 (StgWord64, StgWord64);
+I_ stg_leWord64 (StgWord64, StgWord64);
 
 I_ stg_gtInt64 (StgInt64, StgInt64);
 I_ stg_geInt64 (StgInt64, StgInt64);
@@ -369,8 +435,8 @@ I_ stg_neInt64 (StgInt64, StgInt64);
 I_ stg_ltInt64 (StgInt64, StgInt64);
 I_ stg_leInt64 (StgInt64, StgInt64);
 
-LW_ stg_remWord64  (StgNat64, StgNat64);
-LW_ stg_quotWord64 (StgNat64, StgNat64);
+LW_ stg_remWord64  (StgWord64, StgWord64);
+LW_ stg_quotWord64 (StgWord64, StgWord64);
 
 LI_ stg_remInt64    (StgInt64, StgInt64);
 LI_ stg_quotInt64   (StgInt64, StgInt64);
@@ -379,13 +445,13 @@ LI_ stg_plusInt64   (StgInt64, StgInt64);
 LI_ stg_minusInt64  (StgInt64, StgInt64);
 LI_ stg_timesInt64  (StgInt64, StgInt64);
 
-LW_ stg_and64  (StgNat64, StgNat64);
-LW_ stg_or64   (StgNat64, StgNat64);
-LW_ stg_xor64  (StgNat64, StgNat64);
-LW_ stg_not64  (StgNat64);
+LW_ stg_and64  (StgWord64, StgWord64);
+LW_ stg_or64   (StgWord64, StgWord64);
+LW_ stg_xor64  (StgWord64, StgWord64);
+LW_ stg_not64  (StgWord64);
 
-LW_ stg_shiftL64   (StgNat64, StgInt);
-LW_ stg_shiftRL64  (StgNat64, StgInt);
+LW_ stg_shiftL64   (StgWord64, StgInt);
+LW_ stg_shiftRL64  (StgWord64, StgInt);
 LI_ stg_iShiftL64  (StgInt64, StgInt);
 LI_ stg_iShiftRL64 (StgInt64, StgInt);
 LI_ stg_iShiftRA64 (StgInt64, StgInt);
@@ -395,8 +461,8 @@ I_ stg_int64ToInt     (StgInt64);
 LW_ stg_int64ToWord64 (StgInt64);
 
 LW_ stg_wordToWord64  (StgWord);
-W_  stg_word64ToWord  (StgNat64);
-LI_ stg_word64ToInt64 (StgNat64);
+W_  stg_word64ToWord  (StgWord64);
+LI_ stg_word64ToInt64 (StgWord64);
 #endif
 
 /* -----------------------------------------------------------------------------
@@ -407,97 +473,95 @@ LI_ stg_word64ToInt64 (StgNat64);
  * about increasing the alignment requirements.
  */
 #define REAL_BYTE_ARR_CTS(a)   ((void *) (((StgArrWords *)(a))->payload))
-#define REAL_PTRS_ARR_CTS(a)   ((P_)   (((StgArrPtrs  *)(a))->payload))
+#define REAL_PTRS_ARR_CTS(a)   ((P_)   (((StgMutArrPtrs  *)(a))->payload))
 
 #ifdef DEBUG
-#define BYTE_ARR_CTS(a)                                \
- ({ ASSERT(GET_INFO(a) == &ARR_WORDS_info);    \
+#define BYTE_ARR_CTS(a)                                  \
+ ({ ASSERT(GET_INFO(a) == &ARR_WORDS_info);      \
     REAL_BYTE_ARR_CTS(a); })
-#define PTRS_ARR_CTS(a)                                \
- ({ ASSERT((GET_INFO(a) == &ARR_PTRS_info)     \
-       || (GET_INFO(a) == &MUT_ARR_PTRS_info));\
+#define PTRS_ARR_CTS(a)                                  \
+ ({ ASSERT((GET_INFO(a) == &ARR_PTRS_info)       \
+       || (GET_INFO(a) == &MUT_ARR_PTRS_info));  \
     REAL_PTRS_ARR_CTS(a); })
 #else
 #define BYTE_ARR_CTS(a)                REAL_BYTE_ARR_CTS(a)
 #define PTRS_ARR_CTS(a)                REAL_PTRS_ARR_CTS(a)
 #endif
 
-/* Todo: define... */
 extern I_ genSymZh(void);
 extern I_ resetGenSymZh(void);
-extern I_ incSeqWorldZh(void);
 
 /*--- everything except new*Array is done inline: */
 
-#define sameMutableArrayZh(r,a,b)      r=(I_)((a)==(b))
-#define sameMutableByteArrayZh(r,a,b)  r=(I_)((a)==(b))
+#define sameMutableArrayzh(r,a,b)      r=(I_)((a)==(b))
+#define sameMutableByteArrayzh(r,a,b)  r=(I_)((a)==(b))
 
-#define readArrayZh(r,a,i)      r=((PP_) PTRS_ARR_CTS(a))[(i)]
+#define readArrayzh(r,a,i)      r=((PP_) PTRS_ARR_CTS(a))[(i)]
 
-#define readCharArrayZh(r,a,i)  indexCharOffAddrZh(r,BYTE_ARR_CTS(a),i)
-#define readIntArrayZh(r,a,i)   indexIntOffAddrZh(r,BYTE_ARR_CTS(a),i)
-#define readWordArrayZh(r,a,i)  indexWordOffAddrZh(r,BYTE_ARR_CTS(a),i)
-#define readAddrArrayZh(r,a,i)  indexAddrOffAddrZh(r,BYTE_ARR_CTS(a),i)
-#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 readCharArrayzh(r,a,i)  indexCharOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readIntArrayzh(r,a,i)   indexIntOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readWordArrayzh(r,a,i)  indexWordOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readAddrArrayzh(r,a,i)  indexAddrOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#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)
 #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 readInt64Arrayzh(r,a,i)  indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i)
 #endif
 
 /* result ("r") arg ignored in write macros! */
-#define writeArrayZh(a,i,v)    ((PP_) PTRS_ARR_CTS(a))[(i)]=(v)
+#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 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 writeFloatArrayZh(a,i,v)  \
+#define writeCharArrayzh(a,i,v)          ((C_ *)(BYTE_ARR_CTS(a)))[i] = (v)
+#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 writeFloatArrayzh(a,i,v)  \
        ASSIGN_FLT((P_) (((StgFloat *)(BYTE_ARR_CTS(a))) + i),v)
-#define writeDoubleArrayZh(a,i,v) \
+#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 writeStablePtrArrayzh(a,i,v)     ((StgStablePtr *)(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 writeInt64Arrayzh(a,i,v)  ((LI_ *)(BYTE_ARR_CTS(a)))[i] = (v)
+#define writeWord64Arrayzh(a,i,v) ((LW_ *)(BYTE_ARR_CTS(a)))[i] = (v)
 #endif
 
-#define indexArrayZh(r,a,i)      r=((PP_) PTRS_ARR_CTS(a))[(i)]
+#define indexArrayzh(r,a,i)      r=((PP_) PTRS_ARR_CTS(a))[(i)]
 
-#define indexCharArrayZh(r,a,i)          indexCharOffAddrZh(r,BYTE_ARR_CTS(a),i)
-#define indexIntArrayZh(r,a,i)   indexIntOffAddrZh(r,BYTE_ARR_CTS(a),i)
-#define indexWordArrayZh(r,a,i)          indexWordOffAddrZh(r,BYTE_ARR_CTS(a),i)
-#define indexAddrArrayZh(r,a,i)          indexAddrOffAddrZh(r,BYTE_ARR_CTS(a),i)
-#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 indexCharArrayzh(r,a,i)          indexCharOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexIntArrayzh(r,a,i)   indexIntOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexWordArrayzh(r,a,i)          indexWordOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexAddrArrayzh(r,a,i)          indexAddrOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#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)
 #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 indexInt64Arrayzh(r,a,i)  indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i)
 #endif
 
-#define indexCharOffForeignObjZh(r,fo,i)   indexCharOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#define indexIntOffForeignObjZh(r,fo,i)    indexIntOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#define indexWordOffForeignObjZh(r,fo,i)   indexWordOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#define indexAddrOffForeignObjZh(r,fo,i)   indexAddrOffAddrZh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#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 indexCharOffForeignObjzh(r,fo,i)   indexCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexIntOffForeignObjzh(r,fo,i)    indexIntOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexWordOffForeignObjzh(r,fo,i)   indexWordOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexAddrOffForeignObjzh(r,fo,i)   indexAddrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#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)
 #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)
+#define indexInt64OffForeignObjzh(r,fo,i)  indexInt64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexWord64OffForeignObjzh(r,fo,i) indexWord64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
 #endif
 
-#define indexCharOffAddrZh(r,a,i)   r= ((C_ *)(a))[i]
-#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]
-#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 indexCharOffAddrzh(r,a,i)   r= ((C_ *)(a))[i]
+#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]
+#define indexFloatOffAddrzh(r,a,i)  r= PK_FLT((P_) (((StgFloat *)(a)) + i))
+#define indexDoubleOffAddrzh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i))
 #ifdef SUPPORT_LONG_LONGS
-#define indexInt64OffAddrZh(r,a,i)  r= ((LI_ *)(a))[i]
-#define indexWord64OffAddrZh(r,a,i) r= ((LW_ *)(a))[i]
+#define indexInt64OffAddrzh(r,a,i)  r= ((LI_ *)(a))[i]
+#define indexWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i]
 #endif
 
 /* Freezing arrays-of-ptrs requires changing an info table, for the
@@ -505,77 +569,57 @@ extern I_ incSeqWorldZh(void);
    objects, even if they are in old space.  When they become immutable,
    they can be removed from this scavenge list.         */
 
-#define unsafeFreezeArrayZh(r,a)                                       \
+#define unsafeFreezzeArrayzh(r,a)                                      \
        {                                                               \
         SET_INFO((StgClosure *)a,&MUT_ARR_PTRS_FROZEN_info);            \
        r = a;                                                          \
        }
 
-#define unsafeFreezeByteArrayZh(r,a)   r=(a)
+#define unsafeFreezzeByteArrayzh(r,a)  r=(a)
+#define unsafeThawByteArrayzh(r,a)     r=(a)
+
+EF_(unsafeThawArrayzh_fast);
 
-#define sizeofByteArrayZh(r,a) \
+#define sizzeofByteArrayzh(r,a) \
      r = (((StgArrWords *)(a))->words * sizeof(W_))
-#define sizeofMutableByteArrayZh(r,a) \
+#define sizzeofMutableByteArrayzh(r,a) \
      r = (((StgArrWords *)(a))->words * sizeof(W_))
 
 /* and the out-of-line ones... */
 
-EF_(newCharArrayZh_fast);
-EF_(newIntArrayZh_fast);
-EF_(newWordArrayZh_fast);
-EF_(newAddrArrayZh_fast);
-EF_(newFloatArrayZh_fast);
-EF_(newDoubleArrayZh_fast);
-EF_(newStablePtrArrayZh_fast);
-EF_(newArrayZh_fast);
+EF_(newCharArrayzh_fast);
+EF_(newIntArrayzh_fast);
+EF_(newWordArrayzh_fast);
+EF_(newAddrArrayzh_fast);
+EF_(newFloatArrayzh_fast);
+EF_(newDoubleArrayzh_fast);
+EF_(newStablePtrArrayzh_fast);
+EF_(newArrayzh_fast);
 
 /* encoding and decoding of floats/doubles. */
 
 /* We only support IEEE floating point format */
 #include "ieee-flpt.h"
 
-#if FLOATS_AS_DOUBLES  /* i.e. 64-bit machines */
-#define encodeFloatZh(r, aa,sa,da, expon)   encodeDoubleZh(r, aa,sa,da, expon)
-#else
-#define encodeFloatZh(r, aa,sa,da, expon)      \
-{ MP_INT arg;                                  \
-  /* Does not allocate memory */               \
-                                               \
-  arg._mp_alloc        = aa;                           \
-  arg._mp_size = sa;                           \
-  arg._mp_d    = (unsigned long int *) (BYTE_ARR_CTS(da)); \
-                                               \
-  r = RET_PRIM_STGCALL2(StgFloat, __encodeFloat,&arg,(expon));\
-}
-#endif /* FLOATS_AS_DOUBLES */
-
-#define encodeDoubleZh(r, aa,sa,da, expon)     \
-{ MP_INT arg;                                  \
-  /* Does not allocate memory */               \
-                                               \
-  arg._mp_alloc        = aa;                           \
-  arg._mp_size = sa;                           \
-  arg._mp_d    = (unsigned long int *) (BYTE_ARR_CTS(da)); \
-                                               \
-  r = RET_PRIM_STGCALL2(StgDouble, __encodeDouble,&arg,(expon));\
-}
-
 /* The decode operations are out-of-line because they need to allocate
  * a byte array.
  */
 #ifdef FLOATS_AS_DOUBLES
-#define decodeFloatZh_fast decodeDoubleZh_fast
+#define decodeFloatzh_fast decodeDoublezh_fast
 #else
-EF_(decodeFloatZh_fast);
+EF_(decodeFloatzh_fast);
 #endif
 
-EF_(decodeDoubleZh_fast);
+EF_(decodeDoublezh_fast);
 
 /* grimy low-level support functions defined in StgPrimFloat.c */
 
-extern StgDouble __encodeDouble (MP_INT *s, I_ e);
-extern StgFloat  __encodeFloat  (MP_INT *s, I_ e);
+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);
@@ -593,22 +637,25 @@ extern StgInt    isFloatNegativeZero(StgFloat f);
    newMutVar is out of line.
    -------------------------------------------------------------------------- */
 
-EF_(newMutVarZh_fast);
+EF_(newMutVarzh_fast);
 
-#define readMutVarZh(r,a)       r=(P_)(((StgMutVar *)(a))->var)
-#define writeMutVarZh(a,v)       (P_)(((StgMutVar *)(a))->var)=(v)
-#define sameMutVarZh(r,a,b)      r=(I_)((a)==(b))
+#define readMutVarzh(r,a)       r=(P_)(((StgMutVar *)(a))->var)
+#define writeMutVarzh(a,v)       (P_)(((StgMutVar *)(a))->var)=(v)
+#define sameMutVarzh(r,a,b)      r=(I_)((a)==(b))
 
 /* -----------------------------------------------------------------------------
    MVar PrimOps.
 
    All out of line, because they either allocate or may block.
    -------------------------------------------------------------------------- */
+#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 )
+EF_(newMVarzh_fast);
+EF_(takeMVarzh_fast);
+EF_(putMVarzh_fast);
 
-#define sameMVarZh(r,a,b)        r=(I_)((a)==(b))
-EF_(newMVarZh_fast);
-EF_(takeMVarZh_fast);
-EF_(putMVarZh_fast);
 
 /* -----------------------------------------------------------------------------
    Delay/Wait PrimOps
@@ -620,68 +667,47 @@ EF_(putMVarZh_fast);
    Primitive I/O, error-handling PrimOps
    -------------------------------------------------------------------------- */
 
-EF_(catchZh_fast);
-EF_(raiseZh_fast);
+EF_(catchzh_fast);
+EF_(raisezh_fast);
 
 extern void stg_exit(I_ n)  __attribute__ ((noreturn));
 
 /* -----------------------------------------------------------------------------
-   Stable Pointer PrimOps.
+   Stable Name / Stable Pointer  PrimOps
    -------------------------------------------------------------------------- */
 
 #ifndef PAR
 
-extern StgPtr *stable_ptr_table;
-extern StgPtr *stable_ptr_free;
-#define deRefStablePtrZh(r,sp)   (r=stable_ptr_table[(sp)])
-#define eqStablePtrZh(r,sp1,sp2) (r=(sp1==sp2))
-
-#define freeStablePointer(stable_ptr)                  \
- {                                                     \
-  stable_ptr_table[stable_ptr] = (P_)stable_ptr_free;  \
-  stable_ptr_free = &stable_ptr_table[stable_ptr];     \
- }
-
-EF_(makeStablePtrZh_fast);
-
-#else /* PAR */
-#define deRefStablePtrZh(ri,sp)                                            \
-do {                                                               \
-    fflush(stdout);                                                \
-    fprintf(stderr, "deRefStablePtr#: no stable pointer support.\n");\
-    stg_exit(EXIT_FAILURE);                                        \
-} while(0)
-
-#define eqStablePtrZh(ri,sp1,sp2)                                  \
-do {                                                               \
-    fflush(stdout);                                                \
-    fprintf(stderr, "eqStablePtr#: no stable pointer support.\n");  \
-    stg_exit(EXIT_FAILURE);                                        \
-} while(0)
-
-#define makeStablePtrZh(stablePtr,liveness,unstablePtr)                    \
-do {                                                               \
-    fflush(stdout);                                                \
-    fprintf(stderr, "makeStablePtr#: no stable pointer support.\n");\
-    EXIT(EXIT_FAILURE);                                                    \
-} while(0)
-
-#define freeStablePtrZh(stablePtr,liveness,unstablePtr)                    \
-do {                                                               \
-    fflush(stdout);                                                \
-    fprintf(stderr, "makeStablePtr#: no stable pointer support.\n");\
-    EXIT(EXIT_FAILURE);                                                    \
-} while(0)
-#endif
+EF_(makeStableNamezh_fast);
 
+#define stableNameToIntzh(r,s)   (r = ((StgStableName *)s)->sn)
+
+#define eqStableNamezh(r,sn1,sn2)                                      \
+    (r = (((StgStableName *)sn1)->sn == ((StgStableName *)sn2)->sn))
+
+#define makeStablePtrzh(r,a) \
+   r = RET_STGCALL1(StgStablePtr,getStablePtr,a)
+
+#define deRefStablePtrzh(r,sp) do {            \
+  ASSERT(stable_ptr_table[sp & ~STABLEPTR_WEIGHT_MASK].weight > 0);    \
+  r = stable_ptr_table[sp & ~STABLEPTR_WEIGHT_MASK].addr; \
+} while (0);
+
+#define eqStablePtrzh(r,sp1,sp2) \
+    (r = ((sp1 & ~STABLEPTR_WEIGHT_MASK) == (sp2 & ~STABLEPTR_WEIGHT_MASK)))
+
+#endif
 
 /* -----------------------------------------------------------------------------
    Parallel PrimOps.
    -------------------------------------------------------------------------- */
 
-EF_(forkZh_fast);
-EF_(killThreadZh_fast);
-EF_(seqZh_fast);
+EF_(forkzh_fast);
+EF_(yieldzh_fast);
+EF_(killThreadzh_fast);
+EF_(seqzh_fast);
+
+#define myThreadIdzh(t) (t = CurrentTSO)
 
 /* Hmm, I'll think about these later. */
 /* -----------------------------------------------------------------------------
@@ -694,7 +720,7 @@ EF_(seqZh_fast);
    ToDo: follow indirections.  
 */
 
-#define reallyUnsafePtrEqualityZh(r,a,b) r=((StgPtr)(a) == (StgPtr)(b))
+#define reallyUnsafePtrEqualityzh(r,a,b) r=((StgPtr)(a) == (StgPtr)(b))
 
 /* -----------------------------------------------------------------------------
    Weak Pointer PrimOps.
@@ -702,9 +728,19 @@ EF_(seqZh_fast);
 
 #ifndef PAR
 
-EF_(mkWeakZh_fast);
-EF_(deRefWeakZh_fast);
-#define sameWeakZh(w1,w2)  ((w1)==(w2))
+EF_(mkWeakzh_fast);
+EF_(finalizzeWeakzh_fast);
+
+#define deRefWeakzh(code,val,w)                                \
+  if (((StgWeak *)w)->header.info == &WEAK_info) {     \
+       code = 1;                                       \
+       val = (P_)((StgWeak *)w)->value;                \
+  } else {                                             \
+       code = 0;                                       \
+       val = (P_)w;                                    \
+  }
+
+#define sameWeakzh(w1,w2)  ((w1)==(w2))
 
 #endif
 
@@ -716,9 +752,9 @@ EF_(deRefWeakZh_fast);
 
 #define ForeignObj_CLOSURE_DATA(c)  (((StgForeignObj *)c)->data)
 
-EF_(makeForeignObjZh_fast);
+EF_(makeForeignObjzh_fast);
 
-#define writeForeignObjZh(res,datum) \
+#define writeForeignObjzh(res,datum) \
    (ForeignObj_CLOSURE_DATA(res) = (P_)(datum))
 
 #define eqForeignObj(f1,f2)  ((f1)==(f2))
@@ -726,6 +762,13 @@ EF_(makeForeignObjZh_fast);
 #endif
 
 /* -----------------------------------------------------------------------------
+   Constructor tags
+   -------------------------------------------------------------------------- */
+
+#define dataToTagzh(r,a)  r=(GET_TAG(((StgClosure *)a)->header.info))
+/*  tagToEnum# is handled directly by the code generator. */
+
+/* -----------------------------------------------------------------------------
    Signal processing.  Not really primops, but called directly from
    Haskell. 
    -------------------------------------------------------------------------- */