[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.

diff --git a/GHC/Int.lhs b/GHC/Int.lhs
index d2bf5c2..6fc4c16 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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,