[project @ 1999-12-20 10:12:50 by simonpj]

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

diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h
index bc60247..505a892 100644 (file)
--- a/ghc/includes/PrimOps.h
+++ b/ghc/includes/PrimOps.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.31 1999/05/10 09:56:50 sof Exp $
+ * $Id: PrimOps.h,v 1.41 1999/12/08 14:21:54 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -127,12 +127,12 @@ I_ stg_div (I_ a, I_ b);
 
 #define mulIntCzh(r,c,a,b)                             \
 {                                                      \
-  __asm__("xor %1,%1\n\t                               \
+  __asm__("xorl %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));       \
+       : "=r" (r), "=&r" (c) : "r" (a), "0" (b));      \
 }
 
 #elif SIZEOF_VOID_P == 4
@@ -195,15 +195,21 @@ typedef union {
 #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)
+/* The extra tests below properly define the behaviour when shifting
+ * by offsets larger than the width of the value being shifted.  Doing
+ * so is undefined in C (and in fact gives different answers depending
+ * on whether the operation is constant folded or not with gcc on x86!)
+ */
+
+#define shiftLzh(r,a,b)                r=((b) >= BITS_IN(W_)) ? 0 : (a)<<(b)
+#define shiftRLzh(r,a,b)       r=((b) >= BITS_IN(W_)) ? 0 : (a)>>(b)
+#define iShiftLzh(r,a,b)       r=((b) >= BITS_IN(W_)) ? 0 : (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=((b) >= BITS_IN(I_)) ? (((a) < 0) ? -1 : 0) : (a)>>(b)
+#define iShiftRLzh(r,a,b)      r=((b) >= BITS_IN(I_)) ? 0 : ((W_)(a))>>(b)
 
 #define int2Wordzh(r,a)        r=(W_)(a)
 #define word2Intzh(r,a)        r=(I_)(a)
@@ -349,6 +355,20 @@ typedef union {
   (r) = RET_PRIM_STGCALL2(I_,mpz_cmp_si,&arg,i);               \
 }
 
+/* I think mp_limb_t must be the same size as StgInt for this to work
+ * properly --SDM
+ */
+#define gcdIntzh(r,a,b) \
+{ StgInt aa = a; \
+  r = (aa) ? (b) ? \
+        RET_STGCALL3(StgInt, mpn_gcd_1, (mp_limb_t *)(&aa), 1, (mp_limb_t)(b)) \
+        : abs(aa) \
+      : abs(b); \
+}
+
+#define gcdIntegerIntzh_fast(r,a,sb,b) \
+  RET_STGCALL3(StgInt, mpn_gcd_1, (unsigned long int *) b, sb, (mp_limb_t)(a))
+
 /* The rest are all out-of-line: -------- */
 
 /* Integer arithmetic */
@@ -357,6 +377,9 @@ EF_(minusIntegerzh_fast);
 EF_(timesIntegerzh_fast);
 EF_(gcdIntegerzh_fast);
 EF_(quotRemIntegerzh_fast);
+EF_(quotIntegerzh_fast);
+EF_(remIntegerzh_fast);
+EF_(divExactIntegerzh_fast);
 EF_(divModIntegerzh_fast);
 
 /* Conversions */
@@ -473,11 +496,11 @@ LI_ stg_word64ToInt64 (StgWord64);
 
 #ifdef DEBUG
 #define BYTE_ARR_CTS(a)                                  \
- ({ ASSERT(GET_INFO(a) == &ARR_WORDS_info);      \
+ ({ ASSERT(GET_INFO((StgArrWords *)(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));  \
+ ({ ASSERT((GET_INFO((StgMutArrPtrs  *)(a)) == &MUT_ARR_PTRS_FROZEN_info)        \
+       || (GET_INFO((StgMutArrPtrs  *)(a)) == &MUT_ARR_PTRS_info));  \
     REAL_PTRS_ARR_CTS(a); })
 #else
 #define BYTE_ARR_CTS(a)                REAL_BYTE_ARR_CTS(a)
@@ -657,7 +680,9 @@ EF_(putMVarzh_fast);
    Delay/Wait PrimOps
    -------------------------------------------------------------------------- */
 
-/* Hmm, I'll think about these later. */
+EF_(waitReadzh_fast);
+EF_(waitWritezh_fast);
+EF_(delayzh_fast);
 
 /* -----------------------------------------------------------------------------
    Primitive I/O, error-handling PrimOps
@@ -695,16 +720,20 @@ EF_(makeStableNamezh_fast);
 #endif
 
 /* -----------------------------------------------------------------------------
-   Parallel PrimOps.
+   Concurrency/Exception PrimOps.
    -------------------------------------------------------------------------- */
 
 EF_(forkzh_fast);
 EF_(yieldzh_fast);
 EF_(killThreadzh_fast);
 EF_(seqzh_fast);
+EF_(blockAsyncExceptionszh_fast);
+EF_(unblockAsyncExceptionszh_fast);
 
 #define myThreadIdzh(t) (t = CurrentTSO)
 
+extern int cmp_thread(const StgTSO *tso1, const StgTSO *tso2);
+
 /* Hmm, I'll think about these later. */
 /* -----------------------------------------------------------------------------
    Pointer equality