[project @ 1999-05-10 09:50:49 by simonm]

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

diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h
index 26a873e..87630c4 100644 (file)
--- a/ghc/includes/PrimOps.h
+++ b/ghc/includes/PrimOps.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.20 1999/02/18 12:26:11 simonm Exp $
+ * $Id: PrimOps.h,v 1.30 1999/05/10 09:50:49 simonm Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -58,9 +58,6 @@
 #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[];
-
 /* -----------------------------------------------------------------------------
    Char# PrimOps.
    -------------------------------------------------------------------------- */
@@ -153,15 +150,16 @@ typedef union {
     StgInt32 i[2];
 } long_long_u ;
 
-#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);                             \
-  }                                                                    \
+#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.
@@ -305,16 +303,20 @@ 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, 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_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, sa,da)                               \
@@ -379,7 +381,7 @@ EF_(decodeDoublezh_fast);
 #define integerToWord64zh(r, sa,da)                            \
 { unsigned long int* d;                                                \
   I_ aa;                                                       \
-  StgNat64 res;                                                        \
+  StgWord64 res;                                               \
                                                                \
   d            = (unsigned long int *) (BYTE_ARR_CTS(da));     \
   aa = ((StgArrWords *)da)->words;                             \
@@ -419,12 +421,12 @@ 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);
@@ -433,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);
@@ -443,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);
@@ -459,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
 
 /* -----------------------------------------------------------------------------
@@ -574,6 +576,9 @@ extern I_ resetGenSymZh(void);
        }
 
 #define unsafeFreezzeByteArrayzh(r,a)  r=(a)
+#define unsafeThawByteArrayzh(r,a)     r=(a)
+
+EF_(unsafeThawArrayzh_fast);
 
 #define sizzeofByteArrayzh(r,a) \
      r = (((StgArrWords *)(a))->words * sizeof(W_))
@@ -698,9 +703,12 @@ EF_(makeStableNamezh_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. */
 /* -----------------------------------------------------------------------------
    Pointer equality
@@ -754,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. 
    -------------------------------------------------------------------------- */