From: Ian Lynagh Date: Wed, 8 Jun 2011 20:14:11 +0000 (+0100) Subject: Fix warnings in nativeGen/PPC/CodeGen.hs X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=5c0a4132eb1fe60daa69a1d23c1de0715c8fdab0 Fix warnings in nativeGen/PPC/CodeGen.hs --- diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 7d31e65..0db7641 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -1,4 +1,3 @@ -{-# OPTIONS -w #-} ----------------------------------------------------------------------------- -- @@ -29,7 +28,6 @@ where import PPC.Instr import PPC.Cond import PPC.Regs -import PPC.RegInfo import NCGMonad import Instruction import PIC @@ -48,14 +46,12 @@ import CLabel -- The rest: import StaticFlags ( opt_PIC ) import OrdList -import qualified Outputable as O import Outputable import Unique import DynFlags import Control.Monad ( mapAndUnzipM ) import Data.Bits -import Data.Int import Data.Word import BasicTypes @@ -144,8 +140,8 @@ stmtToInstrs stmt = do 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" @@ -207,17 +203,6 @@ temporary, then do the other computation, and then use the temporary: -} --- | Check whether an integer will fit in 32 bits. --- A CmmInt is intended to be truncated to the appropriate --- number of bits, so here we truncate it to Int64. This is --- important because e.g. -1 as a CmmInt might be either --- -1 or 18446744073709551615. --- -is32BitInteger :: Integer -> Bool -is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000 - where i64 = fromIntegral i :: Int64 - - -- | Convert a BlockId to some CmmStatic data jumpTableEntry :: Maybe BlockId -> CmmStatic jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth) @@ -303,7 +288,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 @@ -316,7 +301,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(powerpc): invalid lvalue" @@ -483,12 +468,12 @@ getRegister' dflags (CmmMachOp mop [x]) -- unary MachOps getRegister' _ (CmmMachOp mop [x, y]) -- dyadic PrimOps = 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_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 rep -> condIntReg EQQ (extendUExpr rep x) (extendUExpr rep y) MO_Ne rep -> condIntReg NE (extendUExpr rep x) (extendUExpr rep y) @@ -536,8 +521,8 @@ getRegister' _ (CmmMachOp mop [x, y]) -- dyadic PrimOps MO_S_MulMayOflo W32 -> trivialCodeNoImm' II32 MULLW_MayOflo x y - MO_S_MulMayOflo rep -> panic "S_MulMayOflo (rep /= II32): not implemented" - MO_U_MulMayOflo rep -> panic "U_MulMayOflo: not implemented" + MO_S_MulMayOflo _ -> panic "S_MulMayOflo (rep /= II32): not implemented" + MO_U_MulMayOflo _ -> panic "U_MulMayOflo: not implemented" MO_S_Quot rep -> trivialCodeNoImm' (intSize rep) DIVW (extendSExpr rep x) (extendSExpr rep y) MO_U_Quot rep -> trivialCodeNoImm' (intSize rep) DIVWU (extendUExpr rep x) (extendUExpr rep y) @@ -590,8 +575,11 @@ getRegister' _ other = pprPanic "getRegister(ppc)" (pprExpr other) -- extend?Rep: wrap integer expression of type rep -- in a conversion to II32 +extendSExpr :: Width -> CmmExpr -> CmmExpr extendSExpr W32 x = x extendSExpr rep x = CmmMachOp (MO_SS_Conv rep W32) [x] + +extendUExpr :: Width -> CmmExpr -> CmmExpr extendUExpr W32 x = x extendUExpr rep x = CmmMachOp (MO_UU_Conv rep W32) [x] @@ -707,9 +695,9 @@ getCondCode (CmmMachOp mop [x, y]) MO_U_Lt rep -> condIntCode LU (extendUExpr rep x) (extendUExpr rep y) MO_U_Le rep -> condIntCode LEU (extendUExpr rep x) (extendUExpr rep y) - other -> pprPanic "getCondCode(powerpc)" (pprMachOp mop) + _ -> pprPanic "getCondCode(powerpc)" (pprMachOp mop) -getCondCode other = panic "getCondCode(2)(powerpc)" +getCondCode _ = panic "getCondCode(2)(powerpc)" @@ -925,8 +913,8 @@ genCCall' gcp target dest_regs argsAndHints (toOL []) [] (labelOrExpr, reduceToFF32) <- case target of - CmmCallee (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False) - CmmCallee expr conv -> return (Right expr, False) + CmmCallee (CmmLit (CmmLabel lbl)) _ -> return (Left lbl, False) + CmmCallee expr _ -> return (Right expr, False) CmmPrim mop -> outOfLineMachOp mop let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode @@ -994,7 +982,7 @@ genCCall' gcp target dest_regs argsAndHints case gcp of GCPDarwin -> - do let storeWord vr (gpr:_) offset = MR gpr vr + do let storeWord vr (gpr:_) _ = MR gpr vr storeWord vr [] offset = ST II32 vr (AddrRegImm sp (ImmInt offset)) passArguments args @@ -1076,12 +1064,20 @@ genCCall' gcp target dest_regs argsAndHints -- the FPRs. FF32 -> (1, 1, 4, fprs) FF64 -> (2, 1, 8, fprs) + II8 -> panic "genCCall' passArguments II8" + II16 -> panic "genCCall' passArguments II16" + II64 -> panic "genCCall' passArguments II64" + FF80 -> panic "genCCall' passArguments FF80" GCPLinux -> case cmmTypeSize rep of II32 -> (1, 0, 4, gprs) -- ... the SysV ABI doesn't. FF32 -> (0, 1, 4, fprs) FF64 -> (0, 1, 8, fprs) + II8 -> panic "genCCall' passArguments II8" + II16 -> panic "genCCall' passArguments II16" + II64 -> panic "genCCall' passArguments II64" + FF80 -> panic "genCCall' passArguments FF80" moveResult reduceToFF32 = case dest_regs of @@ -1094,6 +1090,7 @@ genCCall' gcp target dest_regs argsAndHints | otherwise -> unitOL (MR r_dest r3) where rep = cmmRegType (CmmLocal dest) r_dest = getRegisterReg (CmmLocal dest) + _ -> panic "genCCall' moveResult: Bad dest_regs" outOfLineMachOp mop = do