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@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

1 files changed, 27 insertions, 3 deletions

diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 3b824f375f..68b6bf7445 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'))
-