Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : master
http://hackage.haskell.org/trac/ghc/changeset/4137f8c1259e02dc1992c9d6771f45f495e7cef4 >--------------------------------------------------------------- commit 4137f8c1259e02dc1992c9d6771f45f495e7cef4 Author: Simon Marlow <[email protected]> Date: Wed Oct 24 16:57:39 2012 +0100 Fix #7233: avoid overflow in divInt64# >--------------------------------------------------------------- GHC/Int.hs | 24 ++++++++++++++++-------- 1 files changed, 16 insertions(+), 8 deletions(-) diff --git a/GHC/Int.hs b/GHC/Int.hs index fc1ba49..43125f3 100644 --- a/GHC/Int.hs +++ b/GHC/Int.hs @@ -633,18 +633,26 @@ instance Integral Int64 where divInt64#, modInt64# :: Int64# -> Int64# -> Int64# + +-- Define div in terms of quot, being careful to avoid overflow (#7233) x# `divInt64#` y# - | (x# `gtInt64#` intToInt64# 0#) && (y# `ltInt64#` intToInt64# 0#) - = ((x# `minusInt64#` y#) `minusInt64#` intToInt64# 1#) `quotInt64#` y# - | (x# `ltInt64#` intToInt64# 0#) && (y# `gtInt64#` intToInt64# 0#) - = ((x# `minusInt64#` y#) `plusInt64#` intToInt64# 1#) `quotInt64#` y# - | otherwise = x# `quotInt64#` y# + | (x# `gtInt64#` zero) && (y# `ltInt64#` zero) + = ((x# `minusInt64#` one) `quotInt64#` y#) `minusInt64#` one + | (x# `ltInt64#` zero) && (y# `gtInt64#` zero) + = ((x# `plusInt64#` one) `quotInt64#` y#) `minusInt64#` one + | otherwise + = x# `quotInt64#` y# + where + !zero = intToInt64# 0# + !one = intToInt64# 1# + x# `modInt64#` y# - | (x# `gtInt64#` intToInt64# 0#) && (y# `ltInt64#` intToInt64# 0#) || - (x# `ltInt64#` intToInt64# 0#) && (y# `gtInt64#` intToInt64# 0#) - = if r# `neInt64#` intToInt64# 0# then r# `plusInt64#` y# else intToInt64# 0# + | (x# `gtInt64#` zero) && (y# `ltInt64#` zero) || + (x# `ltInt64#` zero) && (y# `gtInt64#` zero) + = if r# `neInt64#` zero then r# `plusInt64#` y# else zero | otherwise = r# where + !zero = intToInt64# 0# !r# = x# `remInt64#` y# instance Read Int64 where _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
