diff options
author | Peter Trommler <ptrommler@acm.org> | 2019-01-23 23:13:57 +0100 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2019-01-31 12:46:51 -0500 |
commit | 4376d8811418d91bb4d19d61801e95a449b98378 (patch) | |
tree | 8f35c75adb45594201c83a4a643b6a4ef48695cd | |
parent | 438c11cc5ef4b3afa4afe98dd649ce5fd93bb971 (diff) | |
download | haskell-4376d8811418d91bb4d19d61801e95a449b98378.tar.gz |
PPC NCG: Promote integers to word size in C calls
Fixes #16222
-rw-r--r-- | compiler/cmm/CmmType.hs | 8 | ||||
-rw-r--r-- | compiler/nativeGen/PPC/CodeGen.hs | 36 |
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 |