[Git][ghc/ghc][ghc-8.10] 3 commits: nativeGen: One approach to fix #18527
Ben Gamari
gitlab at gitlab.haskell.org
Sat Aug 8 03:22:05 UTC 2020
Ben Gamari pushed to branch ghc-8.10 at Glasgow Haskell Compiler / GHC
Commits:
b260f31f by Ben Gamari at 2020-08-06T17:10:00-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].
(cherry picked from commit a647bae8518e96156eb7775c4cede52b69f711d7)
- - - - -
44f958c8 by Ben Gamari at 2020-08-06T17:10:00-04:00
testsuite: Add test for #18527
- - - - -
29204b1c by Ben Gamari at 2020-08-07T10:53:04-04:00
configure: Fix double-negation in ld merge-objects check
We want to only run the check if ld is gold.
Fixes the fix to #17962.
(cherry picked from commit d589ef25f54862968976bc279eb6748509794566)
- - - - -
7 changed files:
- aclocal.m4
- compiler/cmm/CmmMachOp.hs
- compiler/nativeGen/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:
=====================================
aclocal.m4
=====================================
@@ -2527,7 +2527,7 @@ AC_DEFUN([FIND_LD],[
# Sets $result to 0 if not affected, 1 otherwise
AC_DEFUN([CHECK_FOR_GOLD_T22266],[
AC_MSG_CHECKING([for ld.gold object merging bug (binutils 22266)])
- if ! $1 --version | grep -v -q "GNU gold"; then
+ if ! $1 --version | grep -q "GNU gold"; then
# Not gold
result=0
elif test "$cross_compiling" = "yes"; then
=====================================
compiler/cmm/CmmMachOp.hs
=====================================
@@ -43,6 +43,9 @@ native code generators to handle.
Most operations are parameterised by the 'Width' that they operate on.
Some operations have separate signed and unsigned versions, and float
and integer versions.
+
+Note that there are variety of places in the native code generator where we
+assume that the code produced for a MachOp does not introduce new blocks.
-}
data MachOp
=====================================
compiler/nativeGen/X86/CodeGen.hs
=====================================
@@ -292,11 +292,11 @@ we construct as a separate data type and the actual control flow graph in the co
Instead we now return the new basic block if a statement causes a change
in the current block and use the block for all following statements.
-For this reason genCCall is also split into two parts.
-One for calls which *won't* change the basic blocks in
-which successive instructions will be placed.
-A different one for calls which *are* known to change the
-basic block.
+For this reason genCCall is also split into two parts. One for calls which
+*won't* change the basic blocks in which successive instructions will be
+placed (since they only evaluate CmmExpr, which can only contain MachOps, which
+cannot introduce basic blocks in their lowerings). A different one for calls
+which *are* known to change the basic block.
-}
@@ -1037,6 +1037,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
@@ -2614,9 +2617,12 @@ genCCall' _ is32Bit target dest_regs args bid = do
return code
_ -> panic "genCCall: Wrong number of arguments/results for mul2"
- _ -> if is32Bit
- then genCCall32' dflags target dest_regs args
- else genCCall64' dflags target dest_regs args
+ _ -> do
+ (instrs0, args') <- evalArgs bid args
+ instrs1 <- if is32Bit
+ then genCCall32' dflags target dest_regs args'
+ else genCCall64' dflags 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
@@ -2679,6 +2685,83 @@ 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.
+
+Note that this hack *also* applies to calls to out-of-line PrimTargets (which
+are lowered via a C call) since outOfLineCmmOp produces the call via
+(stmtToInstrs (CmmUnsafeForeignCall ...)), which will ultimately end up
+back in genCCall{32,64}.
+-}
+
+-- | 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
+ dflags <- getDynFlags
+ lreg <- newLocalReg $ cmmExprType dflags actual
+ (instrs, bid1) <- stmtToInstrs bid $ CmmAssign (CmmLocal lreg) actual
+ -- The above assignment shouldn't change the current block
+ MASSERT(isNothing bid1)
+ 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
=====================================
@@ -205,3 +205,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/e69b0d42d88794837694429d33667c2f20931820...29204b1c4f52ea34d84da33593052ee839293bf2
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e69b0d42d88794837694429d33667c2f20931820...29204b1c4f52ea34d84da33593052ee839293bf2
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/20200807/df206d6c/attachment-0001.html>
More information about the ghc-commits
mailing list