From 050a91685f0005d2b8a12c961879dccbe52b84a8 Mon Sep 17 00:00:00 2001 From: simonmar Date: Tue, 19 Mar 2002 11:24:52 +0000 Subject: [PATCH] [project @ 2002-03-19 11:24:51 by simonmar] Fix 64-bit shift operations. - Move the declarations of the 64-bit "primops" from PrimOps.h to HsBase.h where they more properly belong. - change the names of the 64-bit shift ops to include the "unchecked" prefix - add checked versions of these primops to GHC.Int and GHC.Word, and use them. - update the FFI declarations in GHC.Int and GHC.Word while I'm there. --- GHC/Int.lhs | 75 +++++++++++++++++++++++++++++++++--------------------- GHC/Word.lhs | 22 +++++++++++++--- cbits/longlong.c | 12 ++++----- include/HsBase.h | 56 +++++++++++++++++++++++++++++++++++++++- 4 files changed, 125 insertions(+), 40 deletions(-) diff --git a/GHC/Int.lhs b/GHC/Int.lhs index d2bf5c2..6fc4c16 100644 --- a/GHC/Int.lhs +++ b/GHC/Int.lhs @@ -615,41 +615,58 @@ instance Bits Int64 where | i'# ==# 0# = I64# x# | otherwise - = I64# (word64ToInt64# ((x'# `shiftL64#` i'#) `or64#` - (x'# `shiftRL64#` (64# -# i'#)))) + = I64# (word64ToInt64# ((x'# `uncheckedShiftL64#` i'#) `or64#` + (x'# `uncheckedShiftRL64#` (64# -# i'#)))) where x'# = int64ToWord64# x# i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) bitSize _ = 64 isSigned _ = True -foreign import "stg_eqInt64" unsafe eqInt64# :: Int64# -> Int64# -> Bool -foreign import "stg_neInt64" unsafe neInt64# :: Int64# -> Int64# -> Bool -foreign import "stg_ltInt64" unsafe ltInt64# :: Int64# -> Int64# -> Bool -foreign import "stg_leInt64" unsafe leInt64# :: Int64# -> Int64# -> Bool -foreign import "stg_gtInt64" unsafe gtInt64# :: Int64# -> Int64# -> Bool -foreign import "stg_geInt64" unsafe geInt64# :: Int64# -> Int64# -> Bool -foreign import "stg_plusInt64" unsafe plusInt64# :: Int64# -> Int64# -> Int64# -foreign import "stg_minusInt64" unsafe minusInt64# :: Int64# -> Int64# -> Int64# -foreign import "stg_timesInt64" unsafe timesInt64# :: Int64# -> Int64# -> Int64# -foreign import "stg_negateInt64" unsafe negateInt64# :: Int64# -> Int64# -foreign import "stg_quotInt64" unsafe quotInt64# :: Int64# -> Int64# -> Int64# -foreign import "stg_remInt64" unsafe remInt64# :: Int64# -> Int64# -> Int64# -foreign import "stg_intToInt64" unsafe intToInt64# :: Int# -> Int64# -foreign import "stg_int64ToInt" unsafe int64ToInt# :: Int64# -> Int# -foreign import "stg_wordToWord64" unsafe wordToWord64# :: Word# -> Word64# -foreign import "stg_int64ToWord64" unsafe int64ToWord64# :: Int64# -> Word64# -foreign import "stg_word64ToInt64" unsafe word64ToInt64# :: Word64# -> Int64# -foreign import "stg_and64" unsafe and64# :: Word64# -> Word64# -> Word64# -foreign import "stg_or64" unsafe or64# :: Word64# -> Word64# -> Word64# -foreign import "stg_xor64" unsafe xor64# :: Word64# -> Word64# -> Word64# -foreign import "stg_not64" unsafe not64# :: Word64# -> Word64# -foreign import "stg_iShiftL64" unsafe iShiftL64# :: Int64# -> Int# -> Int64# -foreign import "stg_iShiftRA64" unsafe iShiftRA64# :: Int64# -> Int# -> Int64# -foreign import "stg_shiftL64" unsafe shiftL64# :: Word64# -> Int# -> Word64# -foreign import "stg_shiftRL64" unsafe shiftRL64# :: Word64# -> Int# -> Word64# - -foreign import "stg_integerToInt64" unsafe integerToInt64# :: Int# -> ByteArray# -> Int64# + +-- give the 64-bit shift operations the same treatment as the 32-bit +-- ones (see GHC.Base), namely we wrap them in tests to catch the +-- cases when we're shifting more than 64 bits to avoid unspecified +-- behaviour in the C shift operations. + +iShiftL64#, iShiftRA64# :: Int64# -> Int# -> Int64# + +a `iShiftL64#` b | b >=# 64# = intToInt64# 0# + | otherwise = a `uncheckedIShiftL64#` b + +a `iShiftRA64#` b | b >=# 64# = if a `ltInt64#` (intToInt64# 0#) + then intToInt64# (-1#) + else intToInt64# 0# + | otherwise = a `uncheckedIShiftRA64#` b + + +foreign import ccall unsafe "stg_eqInt64" eqInt64# :: Int64# -> Int64# -> Bool +foreign import ccall unsafe "stg_neInt64" neInt64# :: Int64# -> Int64# -> Bool +foreign import ccall unsafe "stg_ltInt64" ltInt64# :: Int64# -> Int64# -> Bool +foreign import ccall unsafe "stg_leInt64" leInt64# :: Int64# -> Int64# -> Bool +foreign import ccall unsafe "stg_gtInt64" gtInt64# :: Int64# -> Int64# -> Bool +foreign import ccall unsafe "stg_geInt64" geInt64# :: Int64# -> Int64# -> Bool +foreign import ccall unsafe "stg_plusInt64" plusInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "stg_minusInt64" minusInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "stg_timesInt64" timesInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "stg_negateInt64" negateInt64# :: Int64# -> Int64# +foreign import ccall unsafe "stg_quotInt64" quotInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "stg_remInt64" remInt64# :: Int64# -> Int64# -> Int64# +foreign import ccall unsafe "stg_intToInt64" intToInt64# :: Int# -> Int64# +foreign import ccall unsafe "stg_int64ToInt" int64ToInt# :: Int64# -> Int# +foreign import ccall unsafe "stg_wordToWord64" wordToWord64# :: Word# -> Word64# +foreign import ccall unsafe "stg_int64ToWord64" int64ToWord64# :: Int64# -> Word64# +foreign import ccall unsafe "stg_word64ToInt64" word64ToInt64# :: Word64# -> Int64# +foreign import ccall unsafe "stg_and64" and64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "stg_or64" or64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "stg_xor64" xor64# :: Word64# -> Word64# -> Word64# +foreign import ccall unsafe "stg_not64" not64# :: Word64# -> Word64# +foreign import ccall unsafe "stg_uncheckedShiftL64" uncheckedShiftL64# :: Word64# -> Int# -> Word64# +foreign import ccall unsafe "stg_uncheckedShiftRL64" uncheckedShiftRL64# :: Word64# -> Int# -> Word64# +foreign import ccall unsafe "stg_uncheckedIShiftL64" uncheckedIShiftL64# :: Int64# -> Int# -> Int64# +foreign import ccall unsafe "stg_uncheckedIShiftRA64" uncheckedIShiftRA64# :: Int64# -> Int# -> Int64# + +foreign import ccall unsafe "stg_integerToInt64" integerToInt64# :: Int# -> ByteArray# -> Int64# {-# RULES "fromIntegral/Int->Int64" fromIntegral = \(I# x#) -> I64# (intToInt64# x#) diff --git a/GHC/Word.lhs b/GHC/Word.lhs index bafd410..5284f59 100644 --- a/GHC/Word.lhs +++ b/GHC/Word.lhs @@ -716,13 +716,27 @@ instance Bits Word64 where | otherwise = W64# (x# `shiftRL64#` negateInt# i#) (W64# x#) `rotate` (I# i#) | i'# ==# 0# = W64# x# - | otherwise = W64# ((x# `shiftL64#` i'#) `or64#` - (x# `shiftRL64#` (64# -# i'#))) + | otherwise = W64# ((x# `uncheckedShiftL64#` i'#) `or64#` + (x# `uncheckedShiftRL64#` (64# -# i'#))) where i'# = word2Int# (int2Word# i# `and#` int2Word# 63#) bitSize _ = 64 isSigned _ = False +-- give the 64-bit shift operations the same treatment as the 32-bit +-- ones (see GHC.Base), namely we wrap them in tests to catch the +-- cases when we're shifting more than 64 bits to avoid unspecified +-- behaviour in the C shift operations. + +shiftL64#, shiftRL64# :: Word64# -> Int# -> Word64# + +a `shiftL64#` b | b >=# 64# = wordToWord64# (int2Word# 0#) + | otherwise = a `uncheckedShiftL64#` b + +a `shiftRL64#` b | b >=# 64# = wordToWord64# (int2Word# 0#) + | otherwise = a `uncheckedShiftRL64#` b + + foreign import ccall unsafe "stg_eqWord64" eqWord64# :: Word64# -> Word64# -> Bool foreign import ccall unsafe "stg_neWord64" neWord64# :: Word64# -> Word64# -> Bool foreign import ccall unsafe "stg_ltWord64" ltWord64# :: Word64# -> Word64# -> Bool @@ -744,8 +758,8 @@ foreign import ccall unsafe "stg_and64" and64# :: Word64# -> Wor foreign import ccall unsafe "stg_or64" or64# :: Word64# -> Word64# -> Word64# foreign import ccall unsafe "stg_xor64" xor64# :: Word64# -> Word64# -> Word64# foreign import ccall unsafe "stg_not64" not64# :: Word64# -> Word64# -foreign import ccall unsafe "stg_shiftL64" shiftL64# :: Word64# -> Int# -> Word64# -foreign import ccall unsafe "stg_shiftRL64" shiftRL64# :: Word64# -> Int# -> Word64# +foreign import ccall unsafe "stg_uncheckedShiftL64" uncheckedShiftL64# :: Word64# -> Int# -> Word64# +foreign import ccall unsafe "stg_uncheckedShiftRL64" uncheckedShiftRL64# :: Word64# -> Int# -> Word64# foreign import ccall unsafe "stg_integerToWord64" integerToWord64# :: Int# -> ByteArray# -> Word64# diff --git a/cbits/longlong.c b/cbits/longlong.c index 4e2af36..4a04abf 100644 --- a/cbits/longlong.c +++ b/cbits/longlong.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: longlong.c,v 1.2 2001/12/21 15:07:26 simonmar Exp $ + * $Id: longlong.c,v 1.3 2002/03/19 11:24:52 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -63,15 +63,15 @@ StgWord64 stg_and64 (StgWord64 a, StgWord64 b) {return a & b;} StgWord64 stg_or64 (StgWord64 a, StgWord64 b) {return a | b;} StgWord64 stg_xor64 (StgWord64 a, StgWord64 b) {return a ^ b;} StgWord64 stg_not64 (StgWord64 a) {return ~a;} -StgWord64 stg_shiftL64 (StgWord64 a, StgInt b) {return a << b;} -StgWord64 stg_shiftRL64 (StgWord64 a, StgInt b) {return a >> b;} +StgWord64 stg_uncheckedShiftL64 (StgWord64 a, StgInt b) {return a << b;} +StgWord64 stg_uncheckedShiftRL64 (StgWord64 a, StgInt b) {return a >> b;} /* Right shifting of signed quantities is not portable in C, so the behaviour you'll get from using these primops depends on the whatever your C compiler is doing. ToDo: fix. -- sof 8/98 */ -StgInt64 stg_iShiftL64 (StgInt64 a, StgInt b) {return a << b;} -StgInt64 stg_iShiftRA64 (StgInt64 a, StgInt b) {return a >> b;} -StgInt64 stg_iShiftRL64 (StgInt64 a, StgInt b) +StgInt64 stg_uncheckedIShiftL64 (StgInt64 a, StgInt b) {return a << b;} +StgInt64 stg_uncheckedIShiftRA64 (StgInt64 a, StgInt b) {return a >> b;} +StgInt64 stg_uncheckedIShiftRL64 (StgInt64 a, StgInt b) {return (StgInt64) ((StgWord64) a >> b);} /* Casting between longs and longer longs. diff --git a/include/HsBase.h b/include/HsBase.h index d5612d7..1a73ebb 100644 --- a/include/HsBase.h +++ b/include/HsBase.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: HsBase.h,v 1.3 2002/02/14 07:31:34 sof Exp $ + * $Id: HsBase.h,v 1.4 2002/03/19 11:24:52 simonmar Exp $ * * (c) The University of Glasgow 2001-2002 * @@ -114,6 +114,60 @@ HsInt systemCmd(HsAddr cmd); int inputReady(int fd, int msecs, int isSock); /* ----------------------------------------------------------------------------- + 64-bit operations, defined in longlong.c + -------------------------------------------------------------------------- */ + +#ifdef SUPPORT_LONG_LONGS + +StgInt stg_gtWord64 (StgWord64, StgWord64); +StgInt stg_geWord64 (StgWord64, StgWord64); +StgInt stg_eqWord64 (StgWord64, StgWord64); +StgInt stg_neWord64 (StgWord64, StgWord64); +StgInt stg_ltWord64 (StgWord64, StgWord64); +StgInt stg_leWord64 (StgWord64, StgWord64); + +StgInt stg_gtInt64 (StgInt64, StgInt64); +StgInt stg_geInt64 (StgInt64, StgInt64); +StgInt stg_eqInt64 (StgInt64, StgInt64); +StgInt stg_neInt64 (StgInt64, StgInt64); +StgInt stg_ltInt64 (StgInt64, StgInt64); +StgInt stg_leInt64 (StgInt64, StgInt64); + +StgWord64 stg_remWord64 (StgWord64, StgWord64); +StgWord64 stg_quotWord64 (StgWord64, StgWord64); + +StgInt64 stg_remInt64 (StgInt64, StgInt64); +StgInt64 stg_quotInt64 (StgInt64, StgInt64); +StgInt64 stg_negateInt64 (StgInt64); +StgInt64 stg_plusInt64 (StgInt64, StgInt64); +StgInt64 stg_minusInt64 (StgInt64, StgInt64); +StgInt64 stg_timesInt64 (StgInt64, StgInt64); + +StgWord64 stg_and64 (StgWord64, StgWord64); +StgWord64 stg_or64 (StgWord64, StgWord64); +StgWord64 stg_xor64 (StgWord64, StgWord64); +StgWord64 stg_not64 (StgWord64); + +StgWord64 stg_uncheckedShiftL64 (StgWord64, StgInt); +StgWord64 stg_uncheckedShiftRL64 (StgWord64, StgInt); +StgInt64 stg_uncheckedIShiftL64 (StgInt64, StgInt); +StgInt64 stg_uncheckedIShiftRL64 (StgInt64, StgInt); +StgInt64 stg_uncheckedIShiftRA64 (StgInt64, StgInt); + +StgInt64 stg_intToInt64 (StgInt); +StgInt stg_int64ToInt (StgInt64); +StgWord64 stg_int64ToWord64 (StgInt64); + +StgWord64 stg_wordToWord64 (StgWord); +StgWord stg_word64ToWord (StgWord64); +StgInt64 stg_word64ToInt64 (StgWord64); + +StgInt64 stg_integerToInt64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da); +StgWord64 stg_integerToWord64 (StgInt sa, StgByteArray /* Really: mp_limb_t* */ da); + +#endif /* SUPPORT_LONG_LONGS */ + +/* ----------------------------------------------------------------------------- INLINE functions. These functions are given as inlines here for when compiling via C, -- 1.7.10.4