[Git][ghc/ghc][master] Cmm: don't perform unsound optimizations on 32-bit compiler hosts

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
7446a09a by Sylvain Henry at 2024-08-07T11:50:35-04:00
Cmm: don't perform unsound optimizations on 32-bit compiler hosts

- beef61351b240967b49169d27a9a19565cf3c4af enabled the use of
  MO_Add/MO_Sub for 64-bit operations in the C and LLVM backends
- 6755d833af8c21bbad6585144b10e20ac4a0a1ab did the same for the x86 NCG
  backend

However we store some literal values as `Int` in the compiler. As a
result, some Cmm optimizations transformed target 64-bit literals into
compiler `Int`. If the compiler is 32-bit, this leads to computing with
wrong literals (see #24893 and #24700).

This patch disables these Cmm optimizations for 32-bit compilers. This
is unsatisfying (optimizations shouldn't be compiler-word-size
dependent) but it fixes the bug and it makes the patch easy to backport.
A proper fix would be much more invasive but it shall be implemented in
the future.

Co-authored-by: amesgen <amesgen at amesgen.de>

- - - - -


7 changed files:

- compiler/GHC/Cmm/Opt.hs
- + testsuite/tests/codeGen/should_run/T24700.hs
- + testsuite/tests/codeGen/should_run/T24700.stdin
- + testsuite/tests/codeGen/should_run/T24700.stdout
- + testsuite/tests/codeGen/should_run/T24893.hs
- + testsuite/tests/codeGen/should_run/T24893.stdout
- testsuite/tests/codeGen/should_run/all.T


Changes:

=====================================
compiler/GHC/Cmm/Opt.hs
=====================================
@@ -237,23 +237,33 @@ cmmMachOpFoldM _ MO_Add{} [ CmmMachOp op at MO_Add{} [pic, CmmLit lit]
   = Just $! CmmMachOp op [pic, CmmLit $ cmmOffsetLit lit off ]
   where off = fromIntegral (narrowS rep n)
 
--- Make a RegOff if we can
+-- Make a RegOff if we can. We don't perform this optimization if rep is greater
+-- than the host word size because we use an Int to store the offset. See
+-- #24893 and #24700. This should be fixed to ensure that optimizations don't
+-- depend on the compiler host platform.
 cmmMachOpFoldM _ (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
+  | validOffsetRep rep
   = Just $! cmmRegOff reg (fromIntegral (narrowS rep n))
 cmmMachOpFoldM _ (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
+  | validOffsetRep rep
   = Just $! cmmRegOff reg (off + fromIntegral (narrowS rep n))
 cmmMachOpFoldM _ (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)]
+  | validOffsetRep rep
   = Just $! cmmRegOff reg (- fromIntegral (narrowS rep n))
 cmmMachOpFoldM _ (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
+  | validOffsetRep rep
   = Just $! cmmRegOff reg (off - fromIntegral (narrowS rep n))
 
 -- Fold label(+/-)offset into a CmmLit where possible
 
 cmmMachOpFoldM _ (MO_Add _) [CmmLit lit, CmmLit (CmmInt i rep)]
+  | validOffsetRep rep
   = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i)))
 cmmMachOpFoldM _ (MO_Add _) [CmmLit (CmmInt i rep), CmmLit lit]
+  | validOffsetRep rep
   = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (narrowU rep i)))
 cmmMachOpFoldM _ (MO_Sub _) [CmmLit lit, CmmLit (CmmInt i rep)]
+  | validOffsetRep rep
   = Just $! CmmLit (cmmOffsetLit lit (fromIntegral (negate (narrowU rep i))))
 
 
@@ -409,6 +419,13 @@ cmmMachOpFoldM platform mop [x, (CmmLit (CmmInt n _))]
 
 cmmMachOpFoldM _ _ _ = Nothing
 
+-- | Check that a literal width is compatible with the host word size used to
+-- store offsets. This should be fixed properly (using larger types to store
+-- literal offsets). See #24893
+validOffsetRep :: Width -> Bool
+validOffsetRep rep = widthInBits rep <= finiteBitSize (undefined :: Int)
+
+
 {- Note [Comparison operators]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 If we have


=====================================
testsuite/tests/codeGen/should_run/T24700.hs
=====================================
@@ -0,0 +1,5 @@
+import Data.Int
+
+main = do
+  input <- getLine
+  print (read input - 3000000000 :: Int64)


=====================================
testsuite/tests/codeGen/should_run/T24700.stdin
=====================================
@@ -0,0 +1 @@
+0


=====================================
testsuite/tests/codeGen/should_run/T24700.stdout
=====================================
@@ -0,0 +1 @@
+-3000000000


=====================================
testsuite/tests/codeGen/should_run/T24893.hs
=====================================
@@ -0,0 +1,8 @@
+import Data.Word
+
+main :: IO ()
+main = print $ 0x8000000000000000 + zero
+
+zero :: Word64
+zero = 0
+{-# NOINLINE zero #-}


=====================================
testsuite/tests/codeGen/should_run/T24893.stdout
=====================================
@@ -0,0 +1 @@
+9223372036854775808


=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -248,3 +248,5 @@ test('T24664a', normal, compile_and_run, ['-O'])
 test('T24664b', normal, compile_and_run, ['-O'])
 test('CtzClz0', normal, compile_and_run, [''])
 test('T23034', req_c, compile_and_run, ['-O2 T23034_c.c'])
+test('T24700', normal, compile_and_run, ['-O'])
+test('T24893', normal, compile_and_run, ['-O'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7446a09a2d5b04b95cd43c03659b5647853124ce

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7446a09a2d5b04b95cd43c03659b5647853124ce
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240807/d645ee07/attachment-0001.html>