Repository : ssh://darcs.haskell.org//srv/darcs/packages/integer-gmp On branch : master
http://hackage.haskell.org/trac/ghc/changeset/225ec4c24be47acb8eaef30a61bd24864ce48f9a >--------------------------------------------------------------- commit 225ec4c24be47acb8eaef30a61bd24864ce48f9a Author: Ian Lynagh <[email protected]> Date: Sun Aug 5 15:55:32 2012 +0100 Define testBitInteger; part of #3489 Based on a patch from [email protected] >--------------------------------------------------------------- GHC/Integer.lhs | 2 +- GHC/Integer/GMP/Prim.hs | 6 ++++++ GHC/Integer/Type.lhs | 7 ++++++- cbits/gmp-wrappers.cmm | 31 +++++++++++++++++++++++++++++++ 4 files changed, 44 insertions(+), 2 deletions(-) diff --git a/GHC/Integer.lhs b/GHC/Integer.lhs index 57a97e1..3802aed 100644 --- a/GHC/Integer.lhs +++ b/GHC/Integer.lhs @@ -33,7 +33,7 @@ module GHC.Integer ( encodeDoubleInteger, decodeDoubleInteger, doubleFromInteger, -- gcdInteger, lcmInteger, andInteger, orInteger, xorInteger, complementInteger, - shiftLInteger, shiftRInteger, + shiftLInteger, shiftRInteger, testBitInteger, hashInteger, ) where diff --git a/GHC/Integer/GMP/Prim.hs b/GHC/Integer/GMP/Prim.hs index 354d55f..cf3b97e 100644 --- a/GHC/Integer/GMP/Prim.hs +++ b/GHC/Integer/GMP/Prim.hs @@ -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# #) diff --git a/GHC/Integer/Type.lhs b/GHC/Integer/Type.lhs index 464deb6..c953786 100644 --- a/GHC/Integer/Type.lhs +++ b/GHC/Integer/Type.lhs @@ -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} %********************************************************* diff --git a/cbits/gmp-wrappers.cmm b/cbits/gmp-wrappers.cmm index ef2df30..7a5ce6c 100644 --- a/cbits/gmp-wrappers.cmm +++ b/cbits/gmp-wrappers.cmm @@ -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) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
