[commit: packages/integer-gmp] master: Add `Addr#` based `{import, export}Integer` variants (caf314e)
git at git.haskell.org
git at git.haskell.org
Thu Nov 7 23:38:31 UTC 2013
Repository : ssh://git@git.haskell.org/integer-gmp
On branch : master
Link : http://git.haskell.org/packages/integer-gmp.git/commitdiff/caf314e79ad2e540fc6159b71d5a1ae27979f192
>---------------------------------------------------------------
commit caf314e79ad2e540fc6159b71d5a1ae27979f192
Author: Herbert Valerio Riedel <hvr at gnu.org>
Date: Thu Nov 7 22:23:36 2013 +0100
Add `Addr#` based `{import,export}Integer` variants
These follow closely the existing implementations for
`importIntegerFromByteArray` and `exportIntegerToMutableByteArray`.
Signed-off-by: Herbert Valerio Riedel <hvr at gnu.org>
>---------------------------------------------------------------
caf314e79ad2e540fc6159b71d5a1ae27979f192
GHC/Integer/GMP/Internals.hs | 2 +-
GHC/Integer/GMP/Prim.hs | 18 +++++++++++++++---
GHC/Integer/Type.lhs | 23 +++++++++++++++++++++--
cbits/gmp-wrappers.cmm | 42 ++++++++++++++++++++++++++++++++++++++++++
4 files changed, 79 insertions(+), 6 deletions(-)
diff --git a/GHC/Integer/GMP/Internals.hs b/GHC/Integer/GMP/Internals.hs
index 54fe70a..fc5ca48 100644
--- a/GHC/Integer/GMP/Internals.hs
+++ b/GHC/Integer/GMP/Internals.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE NoImplicitPrelude #-}
-module GHC.Integer.GMP.Internals (Integer(..), gcdInt, gcdInteger, gcdExtInteger, lcmInteger, powInteger, powModInteger, powModSecInteger, recipModInteger, nextPrimeInteger, testPrimeInteger, sizeInBaseInteger, importIntegerFromByteArray, exportIntegerToMutableByteArray)
+module GHC.Integer.GMP.Internals (Integer(..), gcdInt, gcdInteger, gcdExtInteger, lcmInteger, powInteger, powModInteger, powModSecInteger, recipModInteger, nextPrimeInteger, testPrimeInteger, sizeInBaseInteger, importIntegerFromByteArray, importIntegerFromAddr, exportIntegerToMutableByteArray, exportIntegerToAddr)
where
import GHC.Integer.Type
diff --git a/GHC/Integer/GMP/Prim.hs b/GHC/Integer/GMP/Prim.hs
index 1152166..0fd1b37 100644
--- a/GHC/Integer/GMP/Prim.hs
+++ b/GHC/Integer/GMP/Prim.hs
@@ -50,8 +50,10 @@ module GHC.Integer.GMP.Prim (
testPrimeInteger#,
sizeInBaseInteger#,
- exportIntegerToMutableByteArray#,
importIntegerFromByteArray#,
+ importIntegerFromAddr#,
+ exportIntegerToMutableByteArray#,
+ exportIntegerToAddr#,
#if WORD_SIZE_IN_BITS < 64
int64ToInteger#, integerToInt64#,
@@ -231,13 +233,23 @@ foreign import prim "integer_cmm_sizeInBasezh" sizeInBaseInteger#
-- |
--
+foreign import prim "integer_cmm_importIntegerFromByteArrayzh" importIntegerFromByteArray#
+ :: ByteArray# -> Word# -> Word# -> Int# -> (# Int#, ByteArray# #)
+
+-- |
+--
+foreign import prim "integer_cmm_importIntegerFromAddrzh" importIntegerFromAddr#
+ :: Addr# -> Word# -> Int# -> State# s -> (# State# s, Int#, ByteArray# #)
+
+-- |
+--
foreign import prim "integer_cmm_exportIntegerToMutableByteArrayzh" exportIntegerToMutableByteArray#
:: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #)
-- |
--
-foreign import prim "integer_cmm_importIntegerFromByteArrayzh" importIntegerFromByteArray#
- :: ByteArray# -> Word# -> Word# -> Int# -> (# Int#, ByteArray# #)
+foreign import prim "integer_cmm_exportIntegerToAddrzh" exportIntegerToAddr#
+ :: Int# -> ByteArray# -> Addr# -> Int# -> State# s -> (# State# s, Word# #)
-- |
--
diff --git a/GHC/Integer/Type.lhs b/GHC/Integer/Type.lhs
index 2a654ea..1ebe19f 100644
--- a/GHC/Integer/Type.lhs
+++ b/GHC/Integer/Type.lhs
@@ -23,7 +23,7 @@ module GHC.Integer.Type where
import GHC.Prim (
-- Other types we use, convert from, or convert to
- Int#, Word#, Double#, Float#, ByteArray#, MutableByteArray#, State#,
+ Int#, Word#, Double#, Float#, ByteArray#, MutableByteArray#, Addr#, State#,
-- Conversions between those types
int2Word#, int2Double#, int2Float#, word2Int#,
-- Operations on Int# that we use for operations on S#
@@ -47,7 +47,9 @@ import GHC.Integer.GMP.Prim (
testBitInteger#, mul2ExpInteger#, fdivQ2ExpInteger#,
powInteger#, powModInteger#, powModSecInteger#, recipModInteger#,
nextPrimeInteger#, testPrimeInteger#,
- sizeInBaseInteger#, exportIntegerToMutableByteArray#, importIntegerFromByteArray#,
+ sizeInBaseInteger#,
+ importIntegerFromByteArray#, importIntegerFromAddr#,
+ exportIntegerToMutableByteArray#, exportIntegerToAddr#,
#if WORD_SIZE_IN_BITS < 64
int64ToInteger#, integerToInt64#,
word64ToInteger#, integerToWord64#,
@@ -729,6 +731,14 @@ exportIntegerToMutableByteArray :: Integer -> MutableByteArray# s -> Word# -> In
exportIntegerToMutableByteArray j@(S# _) mba o e = exportIntegerToMutableByteArray (toBig j) mba o e -- TODO
exportIntegerToMutableByteArray (J# s d) mba o e = exportIntegerToMutableByteArray# s d mba o e
+-- | Dump 'Integer' (without sign) to 'Addr#' in base-256 representation.
+--
+-- See description of 'exportIntegerToMutableByteArray' for more details.
+{-# NOINLINE exportIntegerToAddr #-}
+exportIntegerToAddr :: Integer -> Addr# -> Int# -> State# s -> (# State# s, Word# #)
+exportIntegerToAddr (J# s d) addr o e = exportIntegerToAddr# s d addr o e
+exportIntegerToAddr j@(S# _) addr o e = exportIntegerToAddr (toBig j) addr o e -- TODO
+
-- | Read 'Integer' (without sign) from byte-array in base-256 representation.
--
-- The call @importIntegerFromByteArray ba offset size order@ reads
@@ -747,6 +757,15 @@ exportIntegerToMutableByteArray (J# s d) mba o e = exportIntegerToMutableByteArr
importIntegerFromByteArray :: ByteArray# -> Word# -> Word# -> Int# -> Integer
importIntegerFromByteArray ba o l e = case importIntegerFromByteArray# ba o l e of (# s', d' #) -> J# s' d'
+-- | Read 'Integer' (without sign) from memory location at 'Addr#' in
+-- base-256 representation.
+--
+-- See description of 'importIntegerFromByteArray' for more details.
+{-# NOINLINE importIntegerFromAddr #-}
+importIntegerFromAddr :: Addr# -> Word# -> Int# -> State# s -> (# State# s, Integer #)
+importIntegerFromAddr addr l e st = case importIntegerFromAddr# addr l e st of
+ (# st', s', d' #) -> (# st', J# s' d' #)
+
\end{code}
%*********************************************************
diff --git a/cbits/gmp-wrappers.cmm b/cbits/gmp-wrappers.cmm
index a4f4f0c..a578a1b 100644
--- a/cbits/gmp-wrappers.cmm
+++ b/cbits/gmp-wrappers.cmm
@@ -69,6 +69,7 @@ import "integer-gmp" integer_cbits_decodeDouble;
the case for all the platforms that GHC supports, currently.
-------------------------------------------------------------------------- */
+/* :: ByteArray# -> Word# -> Word# -> Int# -> (# Int#, ByteArray# #) */
integer_cmm_importIntegerFromByteArrayzh (P_ ba, W_ of, W_ sz, W_ e)
{
W_ src_ptr;
@@ -89,6 +90,24 @@ again:
MP_INT__mp_d(mp_result) - SIZEOF_StgArrWords);
}
+/* :: Addr# -> Word# -> Int# -> State# s -> (# State# s, Int#, ByteArray# #) */
+integer_cmm_importIntegerFromAddrzh (W_ src_ptr, W_ sz, W_ e)
+{
+ W_ mp_result;
+
+again:
+ STK_CHK_GEN_N (SIZEOF_MP_INT);
+ MAYBE_GC(again);
+
+ mp_result = Sp - SIZEOF_MP_INT;
+
+ ccall __gmpz_init(mp_result "ptr");
+ ccall __gmpz_import(mp_result "ptr", sz, W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, src_ptr "ptr");
+
+ return(TO_W_(MP_INT__mp_size(mp_result)),
+ MP_INT__mp_d(mp_result) - SIZEOF_StgArrWords);
+}
+
/* :: Int# -> ByteArray# -> MutableByteArray# s -> Word# -> Int# -> State# s -> (# State# s, Word# #) */
integer_cmm_exportIntegerToMutableByteArrayzh (W_ s1, P_ d1, P_ mba, W_ of, W_ e)
{
@@ -115,6 +134,29 @@ again:
return (W_[cnt_result]);
}
+/* :: Int# -> ByteArray# -> Addr# -> Int# -> State# s -> (# State# s, Word# #) */
+integer_cmm_exportIntegerToAddrzh (W_ s1, P_ d1, W_ dst_ptr, W_ e)
+{
+ W_ mp_tmp;
+ W_ cnt_result;
+
+again:
+ STK_CHK_GEN_N (SIZEOF_MP_INT + SIZEOF_W);
+ MAYBE_GC(again);
+
+ mp_tmp = Sp - 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);
+
+ cnt_result = Sp - (SIZEOF_MP_INT + SIZEOF_W);
+ W_[cnt_result] = 0;
+
+ ccall __gmpz_export(dst_ptr "ptr", cnt_result "ptr", W_TO_INT(e), W_TO_INT(1), W_TO_INT(0), 0, mp_tmp "ptr");
+
+ return (W_[cnt_result]);
+}
+
integer_cmm_int2Integerzh (W_ val)
{
W_ s, p; /* to avoid aliasing */
More information about the ghc-commits
mailing list