Define testBitInteger; part of #3489
authorIan Lynagh <ian@well-typed.com>
Sun, 5 Aug 2012 14:55:32 +0000 (15:55 +0100)
committerIan Lynagh <ian@well-typed.com>
Sun, 5 Aug 2012 14:55:32 +0000 (15:55 +0100)
Based on a patch from pumpkingod@gmail.com

GHC/Integer.lhs
GHC/Integer/GMP/Prim.hs
GHC/Integer/Type.lhs
cbits/gmp-wrappers.cmm

index 57a97e1..3802aed 100644 (file)
@@ -33,7 +33,7 @@ module GHC.Integer (
     encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger,
     -- gcdInteger, lcmInteger,
     andInteger, orInteger, xorInteger, complementInteger,
-    shiftLInteger, shiftRInteger,
+    shiftLInteger, shiftRInteger, testBitInteger,
     hashInteger,
  ) where
 
index 354d55f..cf3b97e 100644 (file)
@@ -37,6 +37,7 @@ module GHC.Integer.GMP.Prim (
     xorInteger#,
     complementInteger#,
 
+    testBitInteger#,
     mul2ExpInteger#,
     fdivQ2ExpInteger#,
 
@@ -162,6 +163,11 @@ foreign import prim "integer_cmm_xorIntegerzh" xorInteger#
 
 -- |
 --
+foreign import prim "integer_cmm_testBitIntegerzh" testBitInteger#
+  :: Int# -> ByteArray# -> Int# -> Int#
+
+-- |
+--
 foreign import prim "integer_cmm_mul2ExpIntegerzh" mul2ExpInteger#
   :: Int# -> ByteArray# -> Int# -> (# Int#, ByteArray# #)
 
index 464deb6..c953786 100644 (file)
@@ -37,7 +37,7 @@ import GHC.Integer.GMP.Prim (
     decodeDouble#,
     int2Integer#, integer2Int#, word2Integer#, integer2Word#,
     andInteger#, orInteger#, xorInteger#, complementInteger#,
-    mul2ExpInteger#, fdivQ2ExpInteger#,
+    testBitInteger#, mul2ExpInteger#, fdivQ2ExpInteger#,
 #if WORD_SIZE_IN_BITS < 64
     int64ToInteger#,  integerToInt64#,
     word64ToInteger#, integerToWord64#,
@@ -553,6 +553,11 @@ shiftRInteger :: Integer -> Int# -> Integer
 shiftRInteger j@(S# _) i = shiftRInteger (toBig j) i
 shiftRInteger (J# s d) i = case fdivQ2ExpInteger# s d i of
                            (# s', d' #) -> J# s' d'
+
+{-# NOINLINE testBitInteger #-}
+testBitInteger :: Integer -> Int# -> Bool
+testBitInteger j@(S# _) i = testBitInteger (toBig j) i
+testBitInteger (J# s d) i = testBitInteger# s d i /=# 0#
 \end{code}
 
 %*********************************************************
index ef2df30..7a5ce6c 100644 (file)
@@ -299,6 +299,36 @@ name                                                                    \
          MP_INT__mp_d(mp_result) - SIZEOF_StgArrWords);                 \
 }
 
+#define GMP_TAKE1_UL1_RETI1(name,mp_fun)                                \
+name                                                                    \
+{                                                                       \
+  CInt s1;                                                              \
+  W_ d1;                                                                \
+  CLong ul;                                                             \
+  W_ mp_tmp;                                                            \
+  CInt res;                                                             \
+                                                                        \
+  /* call doYouWantToGC() */                                            \
+  MAYBE_GC(R2_PTR, name);                                               \
+                                                                        \
+  STK_CHK_GEN( SIZEOF_MP_INT, R2_PTR, name );                           \
+                                                                        \
+  s1 = W_TO_INT(R1);                                                    \
+  d1 = R2;                                                              \
+  ul = W_TO_LONG(R3);                                                   \
+                                                                        \
+  mp_tmp     = Sp - 1 * SIZEOF_MP_INT;                                  \
+  MP_INT__mp_alloc(mp_tmp) = W_TO_INT(BYTE_ARR_WDS(d1));                \
+  MP_INT__mp_size(mp_tmp)  = (s1);                                      \
+  MP_INT__mp_d(mp_tmp)     = BYTE_ARR_CTS(d1);                          \
+                                                                        \
+  /* Perform the operation */                                           \
+  (res) = foreign "C" mp_fun(mp_tmp "ptr", ul) [];                      \
+  R1 = res;                                                             \
+                                                                        \
+  jump %ENTRY_CODE(Sp(0));                                              \
+}
+
 #define GMP_TAKE1_RET1(name,mp_fun)                                     \
 name                                                                    \
 {                                                                       \
@@ -385,6 +415,7 @@ GMP_TAKE2_RET1(integer_cmm_divExactIntegerzh,       __gmpz_divexact)
 GMP_TAKE2_RET1(integer_cmm_andIntegerzh,            __gmpz_and)
 GMP_TAKE2_RET1(integer_cmm_orIntegerzh,             __gmpz_ior)
 GMP_TAKE2_RET1(integer_cmm_xorIntegerzh,            __gmpz_xor)
+GMP_TAKE1_UL1_RETI1(integer_cmm_testBitIntegerzh,   __gmpz_tstbit)
 GMP_TAKE1_UL1_RET1(integer_cmm_mul2ExpIntegerzh,    __gmpz_mul_2exp)
 GMP_TAKE1_UL1_RET1(integer_cmm_fdivQ2ExpIntegerzh,  __gmpz_fdiv_q_2exp)
 GMP_TAKE1_RET1(integer_cmm_complementIntegerzh,     __gmpz_com)