[Git][ghc/ghc][wip/T18527] 2 commits: nativeGen: One approach to fix #18527

Ben Gamari gitlab at gitlab.haskell.org
Thu Aug 6 01:27:32 UTC 2020



Ben Gamari pushed to branch wip/T18527 at Glasgow Haskell Compiler / GHC


Commits:
d1446316 by Ben Gamari at 2020-08-05T21:25:09-04:00
nativeGen: One approach to fix #18527

Previously the code generator could produce corrupt C call sequences due
to register overlap between MachOp lowerings and the platform's calling
convention. We fix this using a hack described in Note [Evaluate C-call
arguments before placing in destination registers].

- - - - -
d71ed2cd by Ben Gamari at 2020-08-05T21:26:59-04:00
testsuite: Add test fo #18527

- - - - -


5 changed files:

- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- + testsuite/tests/codeGen/should_run/T18527.hs
- + testsuite/tests/codeGen/should_run/T18527.stdout
- + testsuite/tests/codeGen/should_run/T18527FFI.c
- testsuite/tests/codeGen/should_run/all.T


Changes:

=====================================
compiler/GHC/CmmToAsm/X86/CodeGen.hs
=====================================
@@ -1028,6 +1028,9 @@ getRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
           tmp.  This is likely to be better, because the reg alloc can
           eliminate this reg->reg move here (it won't eliminate the other one,
           because the move is into the fixed %ecx).
+      * in the case of C calls the use of ecx here can interfere with arguments.
+        We avoid this with the hack described in Note [Evaluate C-call
+        arguments before placing in destination registers]
     -}
     shift_code width instr x y{-amount-} = do
         x_code <- getAnyReg x
@@ -2022,6 +2025,7 @@ genCCall is32Bit (PrimTarget (MO_AtomicRMW width amop))
     arg <- getNewRegNat format
     arg_code <- getAnyReg n
     platform <- ncgPlatform <$> getConfig
+
     let dst_r    = getRegisterReg platform  (CmmLocal dst)
     (code, lbl) <- op_code dst_r arg amode
     return (addr_code `appOL` arg_code arg `appOL` code, Just lbl)
@@ -2667,9 +2671,12 @@ genCCall' _ is32Bit target dest_regs args bid = do
                return code
         _ -> panic "genCCall: Wrong number of arguments/results for imul2"
 
-    _ -> if is32Bit
-         then genCCall32' target dest_regs args
-         else genCCall64' target dest_regs args
+    _ -> do
+        (instrs0, args') <- evalArgs bid args
+        instrs1 <- if is32Bit
+          then genCCall32' target dest_regs args'
+          else genCCall64' target dest_regs args'
+        return (instrs0 `appOL` instrs1)
 
   where divOp1 platform signed width results [arg_x, arg_y]
             = divOp platform signed width results Nothing arg_x arg_y
@@ -2732,6 +2739,77 @@ genCCall' _ is32Bit target dest_regs args bid = do
         addSubIntC _ _ _ _ _ _ _ _
             = panic "genCCall: Wrong number of arguments/results for addSubIntC"
 
+{-
+Note [Evaluate C-call arguments before placing in destination registers]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+When producing code for C calls we must take care when placing arguments
+in their final registers. Specifically, we must ensure that temporary register
+usage due to evaluation of one argument does not clobber a register in which we
+already placed a previous argument (e.g. as the code generation logic for
+MO_Shl can clobber %rcx due to x86 instruction limitations).
+
+This is precisely what happened in #18527. Consider this C--:
+
+    (result::I64) = call "ccall" doSomething(_s2hp::I64, 2244, _s2hq::I64, _s2hw::I64 | (1 << _s2hz::I64));
+
+Here we are calling the C function `doSomething` with three arguments, the last
+involving a non-trivial expression involving MO_Shl. In this case the NCG could
+naively generate the following assembly (where $tmp denotes some temporary
+register and $argN denotes the register for argument N, as dictated by the
+platform's calling convention):
+
+    mov _s2hp, $arg1   # place first argument
+    mov _s2hq, $arg2   # place second argument
+
+    # Compute 1 << _s2hz
+    mov _s2hz, %rcx
+    shl %cl, $tmp
+
+    # Compute (_s2hw | (1 << _s2hz))
+    mov _s2hw, $arg3
+    or $tmp, $arg3
+
+    # Perform the call
+    call func
+
+This code is outright broken on Windows which assigns $arg1 to %rcx. This means
+that the evaluation of the last argument clobbers the first argument.
+
+To avoid this we use a rather awful hack: when producing code for a C call with
+at least one non-trivial argument, we first evaluate all of the arguments into
+local registers before moving them into their final calling-convention-defined
+homes.  This is performed by 'evalArgs'. Here we define "non-trivial" to be an
+expression which might contain a MachOp since these are the only cases which
+might clobber registers. Furthermore, we use a conservative approximation of
+this condition (only looking at the top-level of CmmExprs) to avoid spending
+too much effort trying to decide whether we want to take the fast path.
+-}
+
+-- | See Note [Evaluate C-call arguments before placing in destination registers]
+evalArgs :: BlockId -> [CmmActual] -> NatM (InstrBlock, [CmmActual])
+evalArgs bid actuals
+  | any mightContainMachOp actuals = do
+      regs_blks <- mapM evalArg actuals
+      return (concatOL $ map fst regs_blks, map snd regs_blks)
+  | otherwise = return (nilOL, actuals)
+  where
+    mightContainMachOp (CmmReg _)      = False
+    mightContainMachOp (CmmRegOff _ _) = False
+    mightContainMachOp (CmmLit _)      = False
+    mightContainMachOp _               = True
+
+    evalArg :: CmmActual -> NatM (InstrBlock, CmmExpr)
+    evalArg actual = do
+        platform <- getPlatform
+        lreg <- newLocalReg $ cmmExprType platform actual
+        (instrs, bid') <- stmtToInstrs bid $ CmmAssign (CmmLocal lreg) actual
+        when (not $ isNothing bid') $ error "uh oh"
+        return (instrs, CmmReg $ CmmLocal lreg)
+
+    newLocalReg :: CmmType -> NatM LocalReg
+    newLocalReg ty = LocalReg <$> getUniqueM <*> pure ty
+
 -- Note [DIV/IDIV for bytes]
 --
 -- IDIV reminder:


=====================================
testsuite/tests/codeGen/should_run/T18527.hs
=====================================
@@ -0,0 +1,20 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Main where
+
+import Data.Bits (setBit)
+import Data.Word (Word32)
+import Data.Int (Int64)
+
+main :: IO ()
+main = offending 100 0 1
+
+offending :: Int64 -> Int64 -> Word32 -> IO ()
+offending h i id = do
+    oldMask <- sendMessage h (2245) i 0
+    let newMask = setBit oldMask (fromIntegral id)
+    sendMessage h (2244) i newMask
+    return ()
+
+foreign import ccall "func"
+    sendMessage :: Int64 -> Word32 -> Int64 -> Int64 -> IO Int64


=====================================
testsuite/tests/codeGen/should_run/T18527.stdout
=====================================
@@ -0,0 +1,3 @@
+ffi call
+ffi call
+


=====================================
testsuite/tests/codeGen/should_run/T18527FFI.c
=====================================
@@ -0,0 +1,14 @@
+#include <stdio.h>
+#include <stdint.h>
+
+int64_t func(int64_t a, uint32_t b, int64_t c, int64_t d) {
+    printf("ffi call");
+    if (a == 1) {
+        printf(" with corrupted convention\n");
+    }
+    else {
+        printf("\n");
+    }
+    return 0;
+}
+


=====================================
testsuite/tests/codeGen/should_run/all.T
=====================================
@@ -207,3 +207,4 @@ test('T16449_2', exit_code(0), compile_and_run, [''])
 test('T16846', [only_ways(['optasm']), exit_code(1)], compile_and_run, [''])
 
 test('T17920', cmm_src, compile_and_run, [''])
+test('T18527', normal, compile_and_run, ['T18527FFI.c'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4fc61c9a0574001f481e36db71ce792df1f99ff9...d71ed2cd6334537d942632c94bdf8ff8613544bf

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4fc61c9a0574001f481e36db71ce792df1f99ff9...d71ed2cd6334537d942632c94bdf8ff8613544bf
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/20200805/c1b59cc1/attachment-0001.html>


More information about the ghc-commits mailing list