[Git][ghc/ghc][master] X86 NCG: Fix argument promotion in foreign C calls

[Marge Bot (@marge-bot)]

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


Commits:
a82121b3 by Peter Trommler at 2024-07-04T11:14:53-04:00
X86 NCG: Fix argument promotion in foreign C calls

Promote 8 bit and 16 bit signed arguments by sign extension.

Fixes #25018

- - - - -


2 changed files:

- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- testsuite/tests/codeGen/should_run/all.T


Changes:

=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -2638,10 +2638,11 @@ genCCall32 :: CmmExpr           -- ^ address of the function to call
            -> [CmmFormal]       -- ^ where to put the result
            -> [CmmActual]       -- ^ arguments (of mixed type)
            -> NatM InstrBlock
-genCCall32 addr _ dest_regs args = do
+genCCall32 addr (ForeignConvention _ argHints _ _) dest_regs args = do
         config <- getConfig
         let platform = ncgPlatform config
-            prom_args = map (maybePromoteCArg platform W32) args
+            args_hints = zip args (argHints ++ repeat NoHint)
+            prom_args = map (maybePromoteCArg platform W32) args_hints
 
             -- If the size is smaller than the word, we widen things (see maybePromoteCArg)
             arg_size_bytes :: CmmType -> Int
@@ -2785,10 +2786,11 @@ genCCall64 :: CmmExpr           -- ^ address of function to call
            -> [CmmFormal]       -- ^ where to put the result
            -> [CmmActual]       -- ^ arguments (of mixed type)
            -> NatM InstrBlock
-genCCall64 addr conv dest_regs args = do
+genCCall64 addr conv@(ForeignConvention _ argHints _ _) dest_regs args = do
     platform <- getPlatform
     -- load up the register arguments
-    let prom_args = map (maybePromoteCArg platform W32) args
+    let args_hints = zip args (argHints ++ repeat NoHint)
+    let prom_args = map (maybePromoteCArg platform W32) args_hints
 
     let load_args :: [CmmExpr]
                   -> [Reg]         -- int regs avail for args
@@ -3023,9 +3025,11 @@ genCCall64 addr conv dest_regs args = do
             assign_code dest_regs)
 
 
-maybePromoteCArg :: Platform -> Width -> CmmExpr -> CmmExpr
-maybePromoteCArg platform wto arg
- | wfrom < wto = CmmMachOp (MO_UU_Conv wfrom wto) [arg]
+maybePromoteCArg :: Platform -> Width -> (CmmExpr, ForeignHint) -> CmmExpr
+maybePromoteCArg platform wto (arg, hint)
+ | wfrom < wto = case hint of
+     SignedHint -> CmmMachOp (MO_SS_Conv wfrom wto) [arg]
+     _          -> CmmMachOp (MO_UU_Conv wfrom wto) [arg]
  | otherwise   = arg
  where
    wfrom = cmmExprWidth platform arg


=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -247,6 +247,4 @@ test('T24295b', normal, compile_and_run, ['-O -floopification -fpedantic-bottoms
 test('T24664a', normal, compile_and_run, ['-O'])
 test('T24664b', normal, compile_and_run, ['-O'])
 test('CtzClz0', normal, compile_and_run, [''])
-test('T23034', [req_c
-               , when(arch('x86_64') and opsys('darwin'), expect_broken(25018))
-               ], compile_and_run, ['-O2 T23034_c.c'])
+test('T23034', req_c, compile_and_run, ['-O2 T23034_c.c'])



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

-- 
This project does not include diff previews in email notifications.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a82121b3b6fdc2ac47211f71871b3ab21e5f6276
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/20240704/016213f0/attachment-0001.html>