[commit: ghc] ghc-7.10: Emulate GMP 5+ operations for GMP 4.x compat (8827ade)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-7.10
Link       : http://ghc.haskell.org/trac/ghc/changeset/8827ade65eee66c42ff6aa11dff20f9b7bece3e2/ghc

>---------------------------------------------------------------

commit 8827ade65eee66c42ff6aa11dff20f9b7bece3e2
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date:   Sun Feb 22 17:50:07 2015 +0100

    Emulate GMP 5+ operations for GMP 4.x compat
    
    The following operations are only (officially) available starting with
    GMP 5.0:
    
    - `mpn_and_n`
    - `mpn_andn_n`
    - `mpn_ior_n`
    - `mpn_xor_n`
    
    In order to properly support GMP 4.x, we simply emulate those operation
    in terms of `mpz_*` operations available in GMP 4.x (unless GMP>=5.x
    available, obviously) while incurring some overhead. Ideally, GMP 4.x
    environments will reach their EOL in the foreseeable future...
    
    This fixes #10003
    
    Reviewed By: austin
    
    Differential Revision: https://phabricator.haskell.org/D675
    
    (cherry picked from commit 5be8ed4da1963ed2d45a65fb61d761c977707cce)


>---------------------------------------------------------------

8827ade65eee66c42ff6aa11dff20f9b7bece3e2
 libraries/integer-gmp2/cbits/wrappers.c        | 80 ++++++++++++++++++++++++++
 libraries/integer-gmp2/src/GHC/Integer/Type.hs |  8 +--
 2 files changed, 84 insertions(+), 4 deletions(-)

diff --git a/libraries/integer-gmp2/cbits/wrappers.c b/libraries/integer-gmp2/cbits/wrappers.c
index 4b710dc..1736efd 100644
--- a/libraries/integer-gmp2/cbits/wrappers.c
+++ b/libraries/integer-gmp2/cbits/wrappers.c
@@ -750,3 +750,83 @@ integer_gmp_invert_word(const mp_limb_t x0, const mp_limb_t m0)
 
   return r0;
 }
+
+
+/* Wrappers for GMP 4.x compat
+ *
+ * In GMP 5.0 the following operations were added:
+ *
+ *  mpn_sqr, mpn_and_n, mpn_ior_n, mpn_xor_n, mpn_nand_n, mpn_nior_n,
+ *  mpn_xnor_n, mpn_andn_n, mpn_iorn_n, mpn_com, mpn_neg, mpn_copyi,
+ *  mpn_copyd, mpn_zero
+ *
+ * We use some of those, but for GMP 4.x compatibility we need to
+ * emulate those (while incurring some overhead).
+ */
+#if __GNU_MP_VERSION < 5
+
+#define MPN_LOGIC_OP_WRAPPER(MPN_WRAPPER, MPZ_OP) \
+void                                                               \
+MPN_WRAPPER(mp_limb_t *rp, const mp_limb_t *s1p,                   \
+            const mp_limb_t *s2p, mp_size_t n)                     \
+{                                                                  \
+  assert(n > 0);                                                   \
+                                                                   \
+  const mpz_t s1 = CONST_MPZ_INIT(s1p, n);                         \
+  const mpz_t s2 = CONST_MPZ_INIT(s2p, n);                         \
+                                                                   \
+  mpz_t r;                                                         \
+  mpz_init (r);                                                    \
+  MPZ_OP (r, s1, s2);                                              \
+                                                                   \
+  const mp_size_t rn = r[0]._mp_size;                              \
+  memset (rp, 0, n*sizeof(mp_limb_t));                             \
+  memcpy (rp, r[0]._mp_d, mp_size_minabs(rn,n)*sizeof(mp_limb_t)); \
+                                                                   \
+  mpz_clear (r);                                                   \
+}
+
+static void
+__mpz_andn(mpz_t r, const mpz_t s1, const mpz_t s2)
+{
+  mpz_t s2c;
+  mpz_init (s2c);
+  mpz_com (s2c, s2);
+  mpz_and (r, s1, s2c);
+  mpz_clear (s2c);
+}
+
+MPN_LOGIC_OP_WRAPPER(integer_gmp_mpn_and_n,  mpz_and)
+MPN_LOGIC_OP_WRAPPER(integer_gmp_mpn_andn_n, __mpz_andn)
+MPN_LOGIC_OP_WRAPPER(integer_gmp_mpn_ior_n,  mpz_ior)
+MPN_LOGIC_OP_WRAPPER(integer_gmp_mpn_xor_n,  mpz_xor)
+
+#else /* __GNU_MP_VERSION >= 5 */
+void
+integer_gmp_mpn_and_n(mp_limb_t *rp, const mp_limb_t *s1p,
+                      const mp_limb_t *s2p, mp_size_t n)
+{
+  mpn_and_n(rp, s1p, s2p, n);
+}
+
+void
+integer_gmp_mpn_andn_n(mp_limb_t *rp, const mp_limb_t *s1p,
+                      const mp_limb_t *s2p, mp_size_t n)
+{
+  mpn_andn_n(rp, s1p, s2p, n);
+}
+
+void
+integer_gmp_mpn_ior_n(mp_limb_t *rp, const mp_limb_t *s1p,
+                      const mp_limb_t *s2p, mp_size_t n)
+{
+  mpn_ior_n(rp, s1p, s2p, n);
+}
+
+void
+integer_gmp_mpn_xor_n(mp_limb_t *rp, const mp_limb_t *s1p,
+                      const mp_limb_t *s2p, mp_size_t n)
+{
+  mpn_xor_n(rp, s1p, s2p, n);
+}
+#endif
diff --git a/libraries/integer-gmp2/src/GHC/Integer/Type.hs b/libraries/integer-gmp2/src/GHC/Integer/Type.hs
index e202855..5670bb4 100644
--- a/libraries/integer-gmp2/src/GHC/Integer/Type.hs
+++ b/libraries/integer-gmp2/src/GHC/Integer/Type.hs
@@ -1575,25 +1575,25 @@ foreign import ccall unsafe "integer_gmp_mpn_lshift"
 
 -- void mpn_and_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
 --                 mp_size_t n)
-foreign import ccall unsafe "gmp.h __gmpn_and_n"
+foreign import ccall unsafe "integer_gmp_mpn_and_n"
   c_mpn_and_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
                  -> IO ()
 
 -- void mpn_andn_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
 --                  mp_size_t n)
-foreign import ccall unsafe "gmp.h __gmpn_andn_n"
+foreign import ccall unsafe "integer_gmp_mpn_andn_n"
   c_mpn_andn_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
                   -> IO ()
 
 -- void mpn_ior_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
 --                 mp_size_t n)
-foreign import ccall unsafe "gmp.h __gmpn_ior_n"
+foreign import ccall unsafe "integer_gmp_mpn_ior_n"
   c_mpn_ior_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
                  -> IO ()
 
 -- void mpn_xor_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,
 --                 mp_size_t n)
-foreign import ccall unsafe "gmp.h __gmpn_xor_n"
+foreign import ccall unsafe "integer_gmp_mpn_xor_n"
   c_mpn_xor_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize#
                  -> IO ()