[Git][ghc/ghc][wip/ncg-simd] X86 genCCall: promote arg before calling evalArgs

[sheaf (@sheaf)]

sheaf pushed to branch wip/ncg-simd at Glasgow Haskell Compiler / GHC


Commits:
0a288d07 by sheaf at 2024-09-21T15:56:57+02:00
X86 genCCall: promote arg before calling evalArgs

The job of evalArgs is to ensure each argument is put into a temporary
register, so that it can then be loaded directly into one of the
argument registers for the C call, without the generated code clobbering
any other register used for argument passing.

However, if we promote arguments after calling evalArgs, there is the
possibility that the code used for the promotion will clobber a register,
defeating the work of evalArgs.
To avoid this, we first promote arguments, and only then call evalArgs.

- - - - -


1 changed file:

- compiler/GHC/CmmToAsm/X86/CodeGen.hs


Changes:

=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -3243,33 +3243,39 @@ genCCall
   -> [CmmFormal]
   -> [CmmActual]
   -> NatM InstrBlock
-genCCall bid addr conv dest_regs args = do
+genCCall bid addr conv@(ForeignConvention _ argHints _ _) dest_regs args = do
+  platform <- getPlatform
   is32Bit <- is32BitPlatform
-  (instrs0, args') <- evalArgs bid args
+  let args_hints = zip args (argHints ++ repeat NoHint)
+      prom_args = map (maybePromoteCArgToW32 platform) args_hints
+  (instrs0, args') <- evalArgs bid prom_args
   instrs1 <- if is32Bit
     then genCCall32 addr conv dest_regs args'
     else genCCall64 addr conv dest_regs args'
   return (instrs0 `appOL` instrs1)
 
-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]
+maybePromoteCArgToW32 :: Platform -> (CmmExpr, ForeignHint) -> CmmExpr
+maybePromoteCArgToW32 platform (arg, hint)
+ | wfrom < wto =
+    -- As wto=W32, we only need to handle integer conversions,
+    -- never Float -> Double.
+    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
+   ty = cmmExprType platform arg
+   wfrom = typeWidth ty
+   wto = W32
 
 genCCall32 :: CmmExpr           -- ^ address of the function to call
            -> ForeignConvention -- ^ calling convention
            -> [CmmFormal]       -- ^ where to put the result
            -> [CmmActual]       -- ^ arguments (of mixed type)
            -> NatM InstrBlock
-genCCall32 addr (ForeignConvention _ argHints _ _) dest_regs args = do
+genCCall32 addr _conv dest_regs args = do
         config <- getConfig
         let platform = ncgPlatform config
-            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
@@ -3339,7 +3345,7 @@ genCCall32 addr (ForeignConvention _ argHints _ _) dest_regs args = do
         delta0 <- getDeltaNat
         setDeltaNat (delta0 - arg_pad_size)
 
-        push_codes <- mapM push_arg (reverse prom_args)
+        push_codes <- mapM push_arg (reverse args)
         delta <- getDeltaNat
         massert (delta == delta0 - tot_arg_size)
 
@@ -3414,11 +3420,9 @@ genCCall64 :: CmmExpr           -- ^ address of function to call
            -> [CmmFormal]       -- ^ where to put the result
            -> [CmmActual]       -- ^ arguments (of mixed type)
            -> NatM InstrBlock
-genCCall64 addr conv@(ForeignConvention _ argHints _ _) dest_regs args = do
+genCCall64 addr conv dest_regs args = do
     config <- getConfig
     let platform = ncgPlatform config
-        args_hints = zip args (argHints ++ repeat NoHint)
-        prom_args = map (maybePromoteCArg platform W32) args_hints
         word_size = platformWordSizeInBytes platform
         wordFmt = archWordFormat (target32Bit platform)
 
@@ -3434,7 +3438,7 @@ genCCall64 addr conv@(ForeignConvention _ argHints _ _) dest_regs args = do
       , usedRegs        = arg_regs_used
       , assignArgsCode  = assign_args_code
       }
-      <- loadArgs config prom_args
+      <- loadArgs config args
 
     let
 



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0a288d07bb5458c5c0d3e17a5fcc63f8059782a2
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/20240921/d6c94d93/attachment-0001.html>