diff options
| -rw-r--r-- | libraries/integer-gmp/GHC/Integer.lhs | 7 | ||||
| -rw-r--r-- | libraries/integer-gmp/GHC/Integer/Internals.hs | 10 | ||||
| -rw-r--r-- | libraries/integer-gmp/cbits/cbits.c | 3 | ||||
| -rw-r--r-- | libraries/integer-gmp/cbits/longlong.c | 66 | ||||
| -rw-r--r-- | libraries/integer-gmp/integer.cabal | 1 |
5 files changed, 81 insertions, 6 deletions
diff --git a/libraries/integer-gmp/GHC/Integer.lhs b/libraries/integer-gmp/GHC/Integer.lhs index 4d32d76245..424001cc88 100644 --- a/libraries/integer-gmp/GHC/Integer.lhs +++ b/libraries/integer-gmp/GHC/Integer.lhs @@ -68,15 +68,16 @@ import GHC.Integer.Internals ( int2Integer#, integer2Int#, word2Integer#, integer2Word#, andInteger#, orInteger#, xorInteger#, complementInteger#, #if WORD_SIZE_IN_BITS < 64 - int64ToInteger#, word64ToInteger#, + int64ToInteger#, integerToInt64#, + word64ToInteger#, integerToWord64#, #endif ) #if WORD_SIZE_IN_BITS < 64 import GHC.IntWord64 ( Int64#, Word64#, - int64ToWord64#, intToInt64#, integerToWord64#, - int64ToInt#, word64ToInt64#, integerToInt64#, + int64ToWord64#, intToInt64#, + int64ToInt#, word64ToInt64#, geInt64#, leInt64#, leWord64#, ) #endif diff --git a/libraries/integer-gmp/GHC/Integer/Internals.hs b/libraries/integer-gmp/GHC/Integer/Internals.hs index e0e87be6b2..a6262b8282 100644 --- a/libraries/integer-gmp/GHC/Integer/Internals.hs +++ b/libraries/integer-gmp/GHC/Integer/Internals.hs @@ -38,8 +38,8 @@ module GHC.Integer.Internals ( complementInteger#, #if WORD_SIZE_IN_BITS < 64 - int64ToInteger#, - word64ToInteger#, + int64ToInteger#, integerToInt64#, + word64ToInteger#, integerToWord64#, #endif #ifndef WORD_SIZE_IN_BITS @@ -190,4 +190,10 @@ foreign import prim "integer_cmm_int64ToIntegerzh" int64ToInteger# foreign import prim "integer_cmm_word64ToIntegerzh" word64ToInteger# :: Word64# -> (# Int#, ByteArray# #) + +foreign import ccall unsafe "hs_integerToInt64" + integerToInt64# :: Int# -> ByteArray# -> Int64# + +foreign import ccall unsafe "hs_integerToWord64" + integerToWord64# :: Int# -> ByteArray# -> Word64# #endif diff --git a/libraries/integer-gmp/cbits/cbits.c b/libraries/integer-gmp/cbits/cbits.c index 4b9fd01480..3d53c6ba62 100644 --- a/libraries/integer-gmp/cbits/cbits.c +++ b/libraries/integer-gmp/cbits/cbits.c @@ -1,5 +1,5 @@ -/* We combine the two C files here. +/* We combine the C files here. * * There is actually a good reason for this, really! * The alloc file contains a __attribute__((constructor)) function. We must @@ -11,3 +11,4 @@ #include "alloc.c" #include "float.c" +#include "longlong.c" diff --git a/libraries/integer-gmp/cbits/longlong.c b/libraries/integer-gmp/cbits/longlong.c new file mode 100644 index 0000000000..2b42380d1e --- /dev/null +++ b/libraries/integer-gmp/cbits/longlong.c @@ -0,0 +1,66 @@ +/* ----------------------------------------------------------------------------- + * $Id: longlong.c,v 1.4 2002/12/13 14:23:42 simonmar Exp $ + * + * (c) The GHC Team, 1998-1999 + * + * Primitive operations over (64-bit) long longs + * (only used on 32-bit platforms.) + * + * ---------------------------------------------------------------------------*/ + + +/* +Primitive Integer conversions to/from HsInt64 and HsWord64s. +N.B. These are not primops! + +Instead of going the normal (boring) route of making the list +of primitive operations even longer to cope with operations +over 64-bit entities, we implement them instead 'out-of-line'. + +The primitive ops get their own routine (in C) that implements +the operation, requiring the caller to _ccall_ out. This has +performance implications of course, but we currently don't +expect intensive use of either Int64 or Word64 types. +*/ + +#include "Rts.h" + +#ifdef SUPPORT_LONG_LONGS + +HsWord64 hs_integerToWord64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da) +{ + mp_limb_t* d; + HsInt s; + HsWord64 res; + d = (mp_limb_t *)da; + s = sa; + switch (s) { + case 0: res = 0; break; + case 1: res = d[0]; break; + case -1: res = -(HsWord64)d[0]; break; + default: + res = (HsWord64)d[0] + ((HsWord64)d[1] << (BITS_IN (mp_limb_t))); + if (s < 0) res = -res; + } + return res; +} + +HsInt64 hs_integerToInt64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da) +{ + mp_limb_t* d; + HsInt s; + HsInt64 res; + d = (mp_limb_t *)da; + s = (sa); + switch (s) { + case 0: res = 0; break; + case 1: res = d[0]; break; + case -1: res = -(HsInt64)d[0]; break; + default: + res = (HsInt64)d[0] + ((HsWord64)d[1] << (BITS_IN (mp_limb_t))); + if (s < 0) res = -res; + } + return res; +} + +#endif /* SUPPORT_LONG_LONGS */ diff --git a/libraries/integer-gmp/integer.cabal b/libraries/integer-gmp/integer.cabal index 71d569af4f..b9a1ea84fc 100644 --- a/libraries/integer-gmp/integer.cabal +++ b/libraries/integer-gmp/integer.cabal @@ -13,6 +13,7 @@ build-type: Configure extra-source-files: cbits/float.c cbits/alloc.c + cbits/longlong.c source-repository head type: darcs |