[commit: ghc] master: UNREG: fix emission of large Integer literals in C codegen (43f1b2e)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/43f1b2ecd1960fa7377cf55a2b97c66059a701ef/ghc

>---------------------------------------------------------------

commit 43f1b2ecd1960fa7377cf55a2b97c66059a701ef
Author: Sergei Trofimovich <slyfox at gentoo.org>
Date:   Tue Aug 26 13:07:14 2014 +0300

    UNREG: fix emission of large Integer literals in C codegen
    
    Summary:
    On amd64/UNREG build there is many failing tests trying
    to deal with 'Integer' types.
    
    Looking at 'integerConversions' test I've observed
    invalid C code generated by GHC.
    
    Cmm code
        CInt a = -1; (a == -1)
    yields 'False' with optimisations enabled via the following C code:
        StgWord64 a = (StgWord32)0xFFFFffffFFFFffffu; (a == 0xFFFFffffFFFFffffu)
    
    The patch fixes it by shrinking emitted literals to required sizes:
        StgWord64 a = (StgWord32)0xFFFFffffu; (a == 0xFFFFffffu)
    
    Thanks to Reid Barton for tracking down and fixing the issue.
    
    Signed-off-by: Sergei Trofimovich <slyfox at gentoo.org>
    
    Test Plan: validate on UNREG build (amd64, x86)
    
    Reviewers: simonmar, rwbarton, austin
    
    Subscribers: hvr, simonmar, ezyang, carter
    
    Differential Revision: https://phabricator.haskell.org/D173


>---------------------------------------------------------------

43f1b2ecd1960fa7377cf55a2b97c66059a701ef
 compiler/cmm/PprC.hs | 30 +++++++++++++++++++++++++++---
 1 file changed, 27 insertions(+), 3 deletions(-)

diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 3b824f3..68b6bf7 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -1223,8 +1223,9 @@ commafy xs = hsep $ punctuate comma xs
 pprHexVal :: Integer -> Width -> SDoc
 pprHexVal 0 _ = ptext (sLit "0x0")
 pprHexVal w rep
-  | w < 0     = parens (char '-' <> ptext (sLit "0x") <> go (-w) <> repsuffix rep)
-  | otherwise = ptext (sLit "0x") <> go w <> repsuffix rep
+  | w < 0     = parens (char '-' <>
+                    ptext (sLit "0x") <> intToDoc (-w) <> repsuffix rep)
+  | otherwise =     ptext (sLit "0x") <> intToDoc   w  <> repsuffix rep
   where
         -- type suffix for literals:
         -- Integer literals are unsigned in Cmm/C.  We explicitly cast to
@@ -1239,10 +1240,33 @@ pprHexVal w rep
           else panic "pprHexVal: Can't find a 64-bit type"
       repsuffix _ = char 'U'
 
+      intToDoc :: Integer -> SDoc
+      intToDoc i = go (truncInt i)
+
+      -- We need to truncate value as Cmm backend does not drop
+      -- redundant bits to ease handling of negative values.
+      -- Thus the following Cmm code on 64-bit arch, like amd64:
+      --     CInt v;
+      --     v = {something};
+      --     if (v == %lobits32(-1)) { ...
+      -- leads to the following C code:
+      --     StgWord64 v = (StgWord32)({something});
+      --     if (v == 0xFFFFffffFFFFffffU) { ...
+      -- Such code is incorrect as it promotes both operands to StgWord64
+      -- and the whole condition is always false.
+      truncInt :: Integer -> Integer
+      truncInt i =
+          case rep of
+              W8  -> i `rem` (2^(8 :: Int))
+              W16 -> i `rem` (2^(16 :: Int))
+              W32 -> i `rem` (2^(32 :: Int))
+              W64 -> i `rem` (2^(64 :: Int))
+              _   -> panic ("pprHexVal/truncInt: C backend can't encode "
+                            ++ show rep ++ " literals")
+
       go 0 = empty
       go w' = go q <> dig
            where
              (q,r) = w' `quotRem` 16
              dig | r < 10    = char (chr (fromInteger r + ord '0'))
                  | otherwise = char (chr (fromInteger r - 10 + ord 'a'))
-