summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPeter Trommler <ptrommler@acm.org>2019-01-23 23:13:57 +0100
committerBen Gamari <ben@smart-cactus.org>2019-01-31 12:46:51 -0500
commit4376d8811418d91bb4d19d61801e95a449b98378 (patch)
tree8f35c75adb45594201c83a4a643b6a4ef48695cd
parent438c11cc5ef4b3afa4afe98dd649ce5fd93bb971 (diff)
downloadhaskell-4376d8811418d91bb4d19d61801e95a449b98378.tar.gz
PPC NCG: Promote integers to word size in C calls
Fixes #16222
-rw-r--r--compiler/cmm/CmmType.hs8
-rw-r--r--compiler/nativeGen/PPC/CodeGen.hs36
2 files changed, 29 insertions, 15 deletions
diff --git a/compiler/cmm/CmmType.hs b/compiler/cmm/CmmType.hs
index 77d894b1c7..0d6e770904 100644
--- a/compiler/cmm/CmmType.hs
+++ b/compiler/cmm/CmmType.hs
@@ -4,7 +4,8 @@ module CmmType
, cInt
, cmmBits, cmmFloat
, typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood
- , isFloatType, isGcPtrType, isWord32, isWord64, isFloat64, isFloat32
+ , isFloatType, isGcPtrType, isBitsType
+ , isWord32, isWord64, isFloat64, isFloat32
, Width(..)
, widthInBits, widthInBytes, widthInLog, widthFromBytes
@@ -132,13 +133,16 @@ cInt :: DynFlags -> CmmType
cInt dflags = cmmBits (cIntWidth dflags)
------------ Predicates ----------------
-isFloatType, isGcPtrType :: CmmType -> Bool
+isFloatType, isGcPtrType, isBitsType :: CmmType -> Bool
isFloatType (CmmType FloatCat _) = True
isFloatType _other = False
isGcPtrType (CmmType GcPtrCat _) = True
isGcPtrType _other = False
+isBitsType (CmmType BitsCat _) = True
+isBitsType _ = False
+
isWord32, isWord64, isFloat32, isFloat64 :: CmmType -> Bool
-- isWord64 is true of 64-bit non-floats (both gc-ptrs and otherwise)
-- isFloat32 and 64 are obvious
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index c6e5304793..516a49aee3 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -1634,15 +1634,13 @@ genCCall'
genCCall' dflags gcp target dest_regs args
- = ASSERT(not $ any (`elem` [II16]) $ map cmmTypeFormat argReps)
- -- we rely on argument promotion in the codeGen
- do
+ = do
(finalStack,passArgumentsCode,usedRegs) <- passArguments
- (zip args argReps)
- allArgRegs
- (allFPArgRegs platform)
- initialStackOffset
- (toOL []) []
+ (zip3 args argReps argHints)
+ allArgRegs
+ (allFPArgRegs platform)
+ initialStackOffset
+ nilOL []
(labelOrExpr, reduceToFF32) <- case target of
ForeignTarget (CmmLit (CmmLabel lbl)) _ -> do
@@ -1733,6 +1731,7 @@ genCCall' dflags gcp target dest_regs args
_ -> panic "genCall': unknown calling conv."
argReps = map (cmmExprType dflags) args
+ (argHints, _) = foreignTargetHints target
roundTo a x | x `mod` a == 0 = x
| otherwise = x + a - (x `mod` a)
@@ -1769,7 +1768,7 @@ genCCall' dflags gcp target dest_regs args
_ -> panic "maybeNOP: Unknown PowerPC 64-bit ABI"
passArguments [] _ _ stackOffset accumCode accumUsed = return (stackOffset, accumCode, accumUsed)
- passArguments ((arg,arg_ty):args) gprs fprs stackOffset
+ passArguments ((arg,arg_ty,_):args) gprs fprs stackOffset
accumCode accumUsed | isWord64 arg_ty
&& target32Bit (targetPlatform dflags) =
do
@@ -1811,9 +1810,9 @@ genCCall' dflags gcp target dest_regs args
stackCode accumUsed
GCP64ELF _ -> panic "passArguments: 32 bit code"
- passArguments ((arg,rep):args) gprs fprs stackOffset accumCode accumUsed
+ passArguments ((arg,rep,hint):args) gprs fprs stackOffset accumCode accumUsed
| reg : _ <- regs = do
- register <- getRegister arg
+ register <- getRegister arg_pro
let code = case register of
Fixed _ freg fcode -> fcode `snocOL` MR reg freg
Any _ acode -> acode reg
@@ -1833,14 +1832,25 @@ genCCall' dflags gcp target dest_regs args
(accumCode `appOL` code)
(reg : accumUsed)
| otherwise = do
- (vr, code) <- getSomeReg arg
+ (vr, code) <- getSomeReg arg_pro
passArguments args
(drop nGprs gprs)
(drop nFprs fprs)
(stackOffset' + stackBytes)
- (accumCode `appOL` code `snocOL` ST (cmmTypeFormat rep) vr stackSlot)
+ (accumCode `appOL` code
+ `snocOL` ST format_pro vr stackSlot)
accumUsed
where
+ arg_pro
+ | isBitsType rep = CmmMachOp (conv_op (typeWidth rep) (wordWidth dflags)) [arg]
+ | otherwise = arg
+ format_pro
+ | isBitsType rep = intFormat (wordWidth dflags)
+ | otherwise = cmmTypeFormat rep
+ conv_op = case hint of
+ SignedHint -> MO_SS_Conv
+ _ -> MO_UU_Conv
+
stackOffset' = case gcp of
GCPAIX ->
-- The 32bit PowerOPEN ABI is happy with