From: David Terei Date: Mon, 9 May 2011 07:16:36 +0000 (-0700) Subject: Fix warnings in X86/CodeGen X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=f910373bac063d182ed82132e2237eaa7491570c Fix warnings in X86/CodeGen --- diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index cc942fb..462c164 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -1,10 +1,3 @@ -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - ----------------------------------------------------------------------------- -- -- Generating machine code (instruction selection) @@ -35,30 +28,25 @@ import X86.Instr import X86.Cond import X86.Regs import X86.RegInfo -import X86.Ppr import Instruction import PIC import NCGMonad import Size import Reg -import RegClass import Platform -- Our intermediate code: import BasicTypes import BlockId -import PprCmm ( pprExpr ) +import PprCmm () import OldCmm -import OldPprCmm +import OldPprCmm () import CLabel -import ClosureInfo ( C_SRT(..) ) -- The rest: import StaticFlags ( opt_PIC ) import ForeignCall ( CCallConv(..) ) import OrdList -import Pretty -import qualified Outputable as O import Outputable import Unique import FastString @@ -66,8 +54,6 @@ import FastBool ( isFastTrue ) import Constants ( wORD_SIZE ) import DynFlags -import Debug.Trace ( trace ) - import Control.Monad ( mapAndUnzipM ) import Data.Maybe ( fromJust, catMaybes ) import Data.Bits @@ -170,8 +156,8 @@ stmtToInstrs stmt = case stmt of CmmBranch id -> genBranch id CmmCondBranch arg id -> genCondJump id arg CmmSwitch arg ids -> genSwitch arg ids - CmmJump arg params -> genJump arg - CmmReturn params -> + CmmJump arg _ -> genJump arg + CmmReturn _ -> panic "stmtToInstrs: return statement should have been cps'd away" @@ -282,8 +268,8 @@ jumpTableEntry (Just blockid) = CmmStaticLit (CmmLabel blockLabel) -- Expand CmmRegOff. ToDo: should we do it this way around, or convert -- CmmExprs into CmmRegOff? -mangleIndexTree :: CmmExpr -> CmmExpr -mangleIndexTree (CmmRegOff reg off) +mangleIndexTree :: CmmReg -> Int -> CmmExpr +mangleIndexTree reg off = CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)] where width = typeWidth (cmmRegType reg) @@ -318,7 +304,7 @@ assignMem_I64Code addrTree valueTree = do assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock -assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do +assignReg_I64Code (CmmLocal (LocalReg u_dst _)) valueTree = do ChildCode64 vcode r_src_lo <- iselExpr64 valueTree let r_dst_lo = RegVirtual $ mkVirtualReg u_dst II32 @@ -331,7 +317,7 @@ assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do vcode `snocOL` mov_lo `snocOL` mov_hi ) -assignReg_I64Code lvalue valueTree +assignReg_I64Code _ _ = panic "assignReg_I64Code(i386): invalid lvalue" @@ -435,8 +421,8 @@ getRegister (CmmReg reg) return (Fixed size (getRegisterReg use_sse2 reg) nilOL) -getRegister tree@(CmmRegOff _ _) - = getRegister (mangleIndexTree tree) +getRegister (CmmRegOff r n) + = getRegister $ mangleIndexTree r n #if WORD_SIZE_IN_BITS==32 @@ -611,7 +597,7 @@ getRegister (CmmMachOp mop [x]) = do -- unary MachOps MO_FS_Conv from to -> coerceFP2Int from to x MO_SF_Conv from to -> coerceInt2FP from to x - other -> pprPanic "getRegister" (pprMachOp mop) + _other -> pprPanic "getRegister" (pprMachOp mop) where triv_ucode :: (Size -> Operand -> Instr) -> Size -> NatM Register triv_ucode instr size = trivialUCode size (instr size) x @@ -648,37 +634,37 @@ getRegister (CmmMachOp mop [x]) = do -- unary MachOps return (swizzleRegisterRep e_code new_size) -getRegister e@(CmmMachOp mop [x, y]) = do -- dyadic MachOps +getRegister (CmmMachOp mop [x, y]) = do -- dyadic MachOps sse2 <- sse2Enabled case mop of - MO_F_Eq w -> condFltReg EQQ x y - MO_F_Ne w -> condFltReg NE x y - MO_F_Gt w -> condFltReg GTT x y - MO_F_Ge w -> condFltReg GE x y - MO_F_Lt w -> condFltReg LTT x y - MO_F_Le w -> condFltReg LE x y - - MO_Eq rep -> condIntReg EQQ x y - MO_Ne rep -> condIntReg NE x y - - MO_S_Gt rep -> condIntReg GTT x y - MO_S_Ge rep -> condIntReg GE x y - MO_S_Lt rep -> condIntReg LTT x y - MO_S_Le rep -> condIntReg LE x y - - MO_U_Gt rep -> condIntReg GU x y - MO_U_Ge rep -> condIntReg GEU x y - MO_U_Lt rep -> condIntReg LU x y - MO_U_Le rep -> condIntReg LEU x y + MO_F_Eq _ -> condFltReg EQQ x y + MO_F_Ne _ -> condFltReg NE x y + MO_F_Gt _ -> condFltReg GTT x y + MO_F_Ge _ -> condFltReg GE x y + MO_F_Lt _ -> condFltReg LTT x y + MO_F_Le _ -> condFltReg LE x y + + MO_Eq _ -> condIntReg EQQ x y + MO_Ne _ -> condIntReg NE x y + + MO_S_Gt _ -> condIntReg GTT x y + MO_S_Ge _ -> condIntReg GE x y + MO_S_Lt _ -> condIntReg LTT x y + MO_S_Le _ -> condIntReg LE x y + + MO_U_Gt _ -> condIntReg GU x y + MO_U_Ge _ -> condIntReg GEU x y + MO_U_Lt _ -> condIntReg LU x y + MO_U_Le _ -> condIntReg LEU x y MO_F_Add w | sse2 -> trivialFCode_sse2 w ADD x y - | otherwise -> trivialFCode_x87 w GADD x y + | otherwise -> trivialFCode_x87 GADD x y MO_F_Sub w | sse2 -> trivialFCode_sse2 w SUB x y - | otherwise -> trivialFCode_x87 w GSUB x y + | otherwise -> trivialFCode_x87 GSUB x y MO_F_Quot w | sse2 -> trivialFCode_sse2 w FDIV x y - | otherwise -> trivialFCode_x87 w GDIV x y + | otherwise -> trivialFCode_x87 GDIV x y MO_F_Mul w | sse2 -> trivialFCode_sse2 w MUL x y - | otherwise -> trivialFCode_x87 w GMUL x y + | otherwise -> trivialFCode_x87 GMUL x y MO_Add rep -> add_code rep x y MO_Sub rep -> sub_code rep x y @@ -703,7 +689,7 @@ getRegister e@(CmmMachOp mop [x, y]) = do -- dyadic MachOps MO_U_Shr rep -> shift_code rep SHR x y {-False-} MO_S_Shr rep -> shift_code rep SAR x y {-False-} - other -> pprPanic "getRegister(x86) - binary CmmMachOp (1)" (pprMachOp mop) + _other -> pprPanic "getRegister(x86) - binary CmmMachOp (1)" (pprMachOp mop) where -------------------- triv_op width instr = trivialCode width op (Just op) x y @@ -740,7 +726,7 @@ getRegister e@(CmmMachOp mop [x, y]) = do -- dyadic MachOps -> NatM Register {- Case1: shift length as immediate -} - shift_code width instr x y@(CmmLit lit) = do + shift_code width instr x (CmmLit lit) = do x_code <- getAnyReg x let size = intSize width @@ -866,8 +852,7 @@ getRegister (CmmLit (CmmInt 0 width)) size = intSize width -- x86_64: 32-bit xor is one byte shorter, and zero-extends to 64 bits - adj_size = case size of II64 -> II32; _ -> size - size1 = IF_ARCH_i386( size, adj_size ) + size1 = IF_ARCH_i386( size, case size of II64 -> II32; _ -> size ) code dst = unitOL (XOR size1 (OpReg dst) (OpReg dst)) in @@ -971,7 +956,7 @@ reg2reg size src dst -------------------------------------------------------------------------------- getAmode :: CmmExpr -> NatM Amode -getAmode tree@(CmmRegOff _ _) = getAmode (mangleIndexTree tree) +getAmode (CmmRegOff r n) = getAmode $ mangleIndexTree r n #if x86_64_TARGET_ARCH @@ -984,14 +969,14 @@ getAmode (CmmMachOp (MO_Add W64) [CmmReg (CmmGlobal PicBaseReg), -- This is all just ridiculous, since it carefully undoes -- what mangleIndexTree has just done. -getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit lit@(CmmInt i _)]) +getAmode (CmmMachOp (MO_Sub _rep) [x, CmmLit lit@(CmmInt i _)]) | is32BitLit lit -- ASSERT(rep == II32)??? = do (x_reg, x_code) <- getSomeReg x let off = ImmInt (-(fromInteger i)) return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code) -getAmode (CmmMachOp (MO_Add rep) [x, CmmLit lit]) +getAmode (CmmMachOp (MO_Add _rep) [x, CmmLit lit]) | is32BitLit lit -- ASSERT(rep == II32)??? = do (x_reg, x_code) <- getSomeReg x @@ -1004,12 +989,12 @@ getAmode (CmmMachOp (MO_Add rep) [a@(CmmMachOp (MO_Shl _) _), b@(CmmLit _)]) = getAmode (CmmMachOp (MO_Add rep) [b,a]) -getAmode (CmmMachOp (MO_Add rep) [x, CmmMachOp (MO_Shl _) +getAmode (CmmMachOp (MO_Add _) [x, CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)]]) | shift == 0 || shift == 1 || shift == 2 || shift == 3 = x86_complex_amode x y shift 0 -getAmode (CmmMachOp (MO_Add rep) +getAmode (CmmMachOp (MO_Add _) [x, CmmMachOp (MO_Add _) [CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)], CmmLit (CmmInt offset _)]]) @@ -1017,7 +1002,7 @@ getAmode (CmmMachOp (MO_Add rep) && is32BitInteger offset = x86_complex_amode x y shift offset -getAmode (CmmMachOp (MO_Add rep) [x,y]) +getAmode (CmmMachOp (MO_Add _) [x,y]) = x86_complex_amode x y 0 0 getAmode (CmmLit lit) | is32BitLit lit @@ -1036,7 +1021,8 @@ x86_complex_amode base index shift offset (y_reg, y_code) <- getSomeReg index let code = x_code `appOL` y_code - base = case shift of 0 -> 1; 1 -> 2; 2 -> 4; 3 -> 8 + base = case shift of 0 -> 1; 1 -> 2; 2 -> 4; 3 -> 8; + n -> panic $ "x86_complex_amode: unhandled shift! (" ++ show n ++ ")" return (Amode (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg base) (ImmInt (fromIntegral offset))) code) @@ -1093,6 +1079,7 @@ getNonClobberedOperand_generic e = do amodeCouldBeClobbered :: AddrMode -> Bool amodeCouldBeClobbered amode = any regClobbered (addrModeRegs amode) +regClobbered :: Reg -> Bool regClobbered (RegReal (RealRegSingle rr)) = isFastTrue (freeReg rr) regClobbered _ = False @@ -1124,6 +1111,7 @@ getOperand (CmmLoad mem pk) = do getOperand e = getOperand_generic e +getOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock) getOperand_generic e = do (reg, code) <- getSomeReg e return (OpReg reg, code) @@ -1170,6 +1158,7 @@ loadFloatAmode use_sse2 w addr addr_code = do -- use it directly from memory. However, if the literal is -- zero, we're better off generating it into a register using -- xor. +isSuitableFloatingPointLit :: CmmLit -> Bool isSuitableFloatingPointLit (CmmFloat f _) = f /= 0.0 isSuitableFloatingPointLit _ = False @@ -1187,12 +1176,13 @@ getRegOrMem e = do (reg, code) <- getNonClobberedReg e return (OpReg reg, code) +is32BitLit :: CmmLit -> Bool #if x86_64_TARGET_ARCH is32BitLit (CmmInt i W64) = is32BitInteger i -- assume that labels are in the range 0-2^31-1: this assumes the -- small memory model (see gcc docs, -mcmodel=small). #endif -is32BitLit x = True +is32BitLit _ = True @@ -1220,20 +1210,20 @@ getCondCode (CmmMachOp mop [x, y]) MO_F_Lt W64 -> condFltCode LTT x y MO_F_Le W64 -> condFltCode LE x y - MO_Eq rep -> condIntCode EQQ x y - MO_Ne rep -> condIntCode NE x y + MO_Eq _ -> condIntCode EQQ x y + MO_Ne _ -> condIntCode NE x y - MO_S_Gt rep -> condIntCode GTT x y - MO_S_Ge rep -> condIntCode GE x y - MO_S_Lt rep -> condIntCode LTT x y - MO_S_Le rep -> condIntCode LE x y + MO_S_Gt _ -> condIntCode GTT x y + MO_S_Ge _ -> condIntCode GE x y + MO_S_Lt _ -> condIntCode LTT x y + MO_S_Le _ -> condIntCode LE x y - MO_U_Gt rep -> condIntCode GU x y - MO_U_Ge rep -> condIntCode GEU x y - MO_U_Lt rep -> condIntCode LU x y - MO_U_Le rep -> condIntCode LEU x y + MO_U_Gt _ -> condIntCode GU x y + MO_U_Ge _ -> condIntCode GEU x y + MO_U_Lt _ -> condIntCode LU x y + MO_U_Le _ -> condIntCode LEU x y - other -> pprPanic "getCondCode(x86,x86_64,sparc)" (ppr (CmmMachOp mop [x,y])) + _other -> pprPanic "getCondCode(x86,x86_64,sparc)" (ppr (CmmMachOp mop [x,y])) getCondCode other = pprPanic "getCondCode(2)(x86,sparc)" (ppr other) @@ -1257,8 +1247,8 @@ condIntCode cond (CmmLoad x pk) (CmmLit lit) | is32BitLit lit = do -- anything vs zero, using a mask -- TODO: Add some sanity checking!!!! -condIntCode cond (CmmMachOp (MO_And rep) [x,o2]) (CmmLit (CmmInt 0 pk)) - | (CmmLit lit@(CmmInt mask pk2)) <- o2, is32BitLit lit +condIntCode cond (CmmMachOp (MO_And _) [x,o2]) (CmmLit (CmmInt 0 pk)) + | (CmmLit lit@(CmmInt mask _)) <- o2, is32BitLit lit = do (x_reg, x_code) <- getSomeReg x let @@ -1310,7 +1300,6 @@ condFltCode cond x y = ASSERT(cond `elem` ([EQQ, NE, LE, LTT, GE, GTT])) do (x_reg, x_code) <- getNonClobberedReg x (y_reg, y_code) <- getSomeReg y - use_sse2 <- sse2Enabled let code = x_code `appOL` y_code `snocOL` GCMP cond x_reg y_reg @@ -1400,7 +1389,7 @@ assignReg_IntCode pk reg (CmmLoad src _) = do return (load_code (getRegisterReg False{-no sse2-} reg)) -- dst is a reg, but src could be anything -assignReg_IntCode pk reg src = do +assignReg_IntCode _ reg src = do code <- getAnyReg src return (code (getRegisterReg False{-no sse2-} reg)) @@ -1418,7 +1407,7 @@ assignMem_FltCode pk addr src = do return code -- Floating point assignment to a register/temporary -assignReg_FltCode pk reg src = do +assignReg_FltCode _ reg src = do use_sse2 <- sse2Enabled src_code <- getAnyReg src return (src_code (getRegisterReg use_sse2 reg)) @@ -1426,7 +1415,7 @@ assignReg_FltCode pk reg src = do genJump :: CmmExpr{-the branch target-} -> NatM InstrBlock -genJump (CmmLoad mem pk) = do +genJump (CmmLoad mem _) = do Amode target code <- getAmode mem return (code `snocOL` JMP (OpAddr target)) @@ -1544,14 +1533,18 @@ genCCall (CmmPrim op) [r_hinted@(CmmHinted r _)] args = do MO_F32_Tan -> actuallyInlineFloatOp (\s -> GTAN s l1 l2) FF32 args MO_F64_Tan -> actuallyInlineFloatOp (\s -> GTAN s l1 l2) FF64 args - other_op -> outOfLineCmmOp op (Just r_hinted) args + _other_op -> outOfLineCmmOp op (Just r_hinted) args where actuallyInlineFloatOp instr size [CmmHinted x _] - = do res <- trivialUFCode size (instr size) x + = do res <- trivialUFCode size (instr size) x any <- anyReg res return (any (getRegisterReg False (CmmLocal r))) + actuallyInlineFloatOp _ _ args + = panic $ "genCCall.actuallyInlineFloatOp: bad number of arguments! (" + ++ show (length args) ++ ")" + genCCall target dest_regs args = do let sizes = map (arg_size . cmmExprType . hintlessCmm) (reverse args) @@ -1652,8 +1645,10 @@ genCCall target dest_regs args = do arg_size :: CmmType -> Int -- Width in bytes arg_size ty = widthInBytes (typeWidth ty) +#if darwin_TARGET_OS roundTo a x | x `mod` a == 0 = x | otherwise = x + a - (x `mod` a) +#endif push_arg :: Bool -> HintedCmmActual {-current argument-} -> NatM InstrBlock -- code @@ -1935,6 +1930,8 @@ outOfLineCmmOp mop res args MO_Memset -> fsLit "memset" MO_Memmove -> fsLit "memmove" + other -> panic $ "outOfLineCmmOp: unmatched op! (" ++ show other ++ ")" + -- ----------------------------------------------------------------------------- -- Generating a table-branch @@ -2003,6 +2000,7 @@ generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop Instr) generateJumpTableForInstr (JMP_TBL _ ids section lbl) = Just (createJumpTable ids section lbl) generateJumpTableForInstr _ = Nothing +createJumpTable :: [Maybe BlockId] -> Section -> CLabel -> GenCmmTop CmmStatic h g createJumpTable ids section lbl = let jumpTable | opt_PIC = @@ -2158,7 +2156,10 @@ SDM's version of The Rules: register happens to be the destination register. -} -trivialCode width instr (Just revinstr) (CmmLit lit_a) b +trivialCode :: Width -> (Operand -> Operand -> Instr) + -> Maybe (Operand -> Operand -> Instr) + -> CmmExpr -> CmmExpr -> NatM Register +trivialCode width _ (Just revinstr) (CmmLit lit_a) b | is32BitLit lit_a = do b_code <- getAnyReg b let @@ -2168,10 +2169,12 @@ trivialCode width instr (Just revinstr) (CmmLit lit_a) b -- in return (Any (intSize width) code) -trivialCode width instr maybe_revinstr a b +trivialCode width instr _ a b = genTrivialCode (intSize width) instr a b -- This is re-used for floating pt instructions too. +genTrivialCode :: Size -> (Operand -> Operand -> Instr) + -> CmmExpr -> CmmExpr -> NatM Register genTrivialCode rep instr a b = do (b_op, b_code) <- getNonClobberedOperand b a_code <- getAnyReg a @@ -2196,12 +2199,15 @@ genTrivialCode rep instr a b = do -- in return (Any rep code) +regClashesWithOp :: Reg -> Operand -> Bool reg `regClashesWithOp` OpReg reg2 = reg == reg2 reg `regClashesWithOp` OpAddr amode = any (==reg) (addrModeRegs amode) -reg `regClashesWithOp` _ = False +_ `regClashesWithOp` _ = False ----------- +trivialUCode :: Size -> (Operand -> Instr) + -> CmmExpr -> NatM Register trivialUCode rep instr x = do x_code <- getAnyReg x let @@ -2212,7 +2218,9 @@ trivialUCode rep instr x = do ----------- -trivialFCode_x87 width instr x y = do +trivialFCode_x87 :: (Size -> Reg -> Reg -> Reg -> Instr) + -> CmmExpr -> CmmExpr -> NatM Register +trivialFCode_x87 instr x y = do (x_reg, x_code) <- getNonClobberedReg x -- these work for float regs too (y_reg, y_code) <- getSomeReg y let @@ -2223,11 +2231,14 @@ trivialFCode_x87 width instr x y = do instr size x_reg y_reg dst return (Any size code) +trivialFCode_sse2 :: Width -> (Size -> Operand -> Operand -> Instr) + -> CmmExpr -> CmmExpr -> NatM Register trivialFCode_sse2 pk instr x y = genTrivialCode size (instr size) x y where size = floatSize pk +trivialUFCode :: Size -> (Reg -> Reg -> Instr) -> CmmExpr -> NatM Register trivialUFCode size instr x = do (x_reg, x_code) <- getSomeReg x let @@ -2245,7 +2256,9 @@ coerceInt2FP from to x = if_sse2 coerce_sse2 coerce_x87 coerce_x87 = do (x_reg, x_code) <- getSomeReg x let - opc = case to of W32 -> GITOF; W64 -> GITOD + opc = case to of W32 -> GITOF; W64 -> GITOD; + n -> panic $ "coerceInt2FP.x87: unhandled width (" + ++ show n ++ ")" code dst = x_code `snocOL` opc x_reg dst -- ToDo: works for non-II32 reps? return (Any FF80 code) @@ -2254,6 +2267,8 @@ coerceInt2FP from to x = if_sse2 coerce_sse2 coerce_x87 (x_op, x_code) <- getOperand x -- ToDo: could be a safe operand let opc = case to of W32 -> CVTSI2SS; W64 -> CVTSI2SD + n -> panic $ "coerceInt2FP.sse: unhandled width (" + ++ show n ++ ")" code dst = x_code `snocOL` opc (intSize from) x_op dst -- in return (Any (floatSize to) code) @@ -2267,6 +2282,8 @@ coerceFP2Int from to x = if_sse2 coerceFP2Int_sse2 coerceFP2Int_x87 (x_reg, x_code) <- getSomeReg x let opc = case from of W32 -> GFTOI; W64 -> GDTOI + n -> panic $ "coerceFP2Int.x87: unhandled width (" + ++ show n ++ ")" code dst = x_code `snocOL` opc x_reg dst -- ToDo: works for non-II32 reps? -- in @@ -2275,7 +2292,9 @@ coerceFP2Int from to x = if_sse2 coerceFP2Int_sse2 coerceFP2Int_x87 coerceFP2Int_sse2 = do (x_op, x_code) <- getOperand x -- ToDo: could be a safe operand let - opc = case from of W32 -> CVTTSS2SIQ; W64 -> CVTTSD2SIQ + opc = case from of W32 -> CVTTSS2SIQ; W64 -> CVTTSD2SIQ; + n -> panic $ "coerceFP2Init.sse: unhandled width (" + ++ show n ++ ")" code dst = x_code `snocOL` opc (intSize to) x_op dst -- in return (Any (intSize to) code) @@ -2288,7 +2307,9 @@ coerceFP2FP to x = do use_sse2 <- sse2Enabled (x_reg, x_code) <- getSomeReg x let - opc | use_sse2 = case to of W32 -> CVTSD2SS; W64 -> CVTSS2SD + opc | use_sse2 = case to of W32 -> CVTSD2SS; W64 -> CVTSS2SD; + n -> panic $ "coerceFP2FP: unhandled width (" + ++ show n ++ ")" | otherwise = GDTOF code dst = x_code `snocOL` opc x_reg dst -- in