Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/79f275092de54ba5f7e7336c13231ad5198befdf >--------------------------------------------------------------- commit 79f275092de54ba5f7e7336c13231ad5198befdf Author: David Terei <[email protected]> Date: Fri May 27 17:11:54 2011 -0700 Fix some validation errors >--------------------------------------------------------------- compiler/main/DriverPipeline.hs | 1 - compiler/main/SysTools.lhs | 3 +- compiler/nativeGen/PPC/CodeGen.hs | 4 +- compiler/nativeGen/SPARC/CodeGen/CCall.hs | 4 +- compiler/nativeGen/X86/CodeGen.hs | 34 +++++++++++++--------------- 5 files changed, 21 insertions(+), 25 deletions(-) diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 2719470..afbd03e 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -2007,5 +2007,4 @@ hscNextPhase dflags _ hsc_lang = HscLlvm -> LlvmOpt HscNothing -> StopLn HscInterpreted -> StopLn - _other -> StopLn diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index 3f69995..e40312c 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -59,7 +59,6 @@ import System.IO import System.IO.Error as IO import System.Directory import Data.Char -import Data.Maybe ( isNothing ) import Data.List import qualified Data.Map as Map import Text.ParserCombinators.ReadP hiding (char) @@ -443,7 +442,7 @@ figureLlvmVersion dflags = do ver <- catchIO (do (pin, pout, perr, _) <- runInteractiveProcess pgm args' Nothing Nothing - {- $ llc -version + {- > llc -version Low Level Virtual Machine (http://llvm.org/): llvm version 2.8 (Ubuntu 2.8-0Ubuntu1) ... diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index ae8ef40..736d564 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -942,10 +942,10 @@ genCCall target dest_regs argsAndHints (mop == MO_Memcpy || mop == MO_Memset || mop == MO_Memmove) - -> init argsAndHints + = init argsAndHints | otherwise - -> argsAndHints + = argsAndHints args = map hintlessCmm argsAndHints' argReps = map cmmExprType args diff --git a/compiler/nativeGen/SPARC/CodeGen/CCall.hs b/compiler/nativeGen/SPARC/CodeGen/CCall.hs index d488168..0a26c23 100644 --- a/compiler/nativeGen/SPARC/CodeGen/CCall.hs +++ b/compiler/nativeGen/SPARC/CodeGen/CCall.hs @@ -85,10 +85,10 @@ genCCall target dest_regs argsAndHints (mop == MO_Memcpy || mop == MO_Memset || mop == MO_Memmove) - -> init argsAndHints + = init argsAndHints | otherwise - -> argsAndHints + = argsAndHints -- strip hints from the arg regs let args :: [CmmExpr] diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index 462c164..2f3e139 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -54,12 +54,16 @@ import FastBool ( isFastTrue ) import Constants ( wORD_SIZE ) import DynFlags -import Control.Monad ( mapAndUnzipM ) -import Data.Maybe ( fromJust, catMaybes ) -import Data.Bits -import Data.Word +import Control.Monad ( mapAndUnzipM ) +import Data.Maybe ( catMaybes ) import Data.Int +#if WORD_SIZE_IN_BITS==32 +import Data.Maybe ( fromJust ) +import Data.Word +import Data.Bits +#endif + sse2Enabled :: NatM Bool #if x86_64_TARGET_ARCH -- SSE2 is fixed on for x86_64. It would be possible to make it optional, @@ -176,6 +180,7 @@ data CondCode = CondCode Bool Cond InstrBlock +#if WORD_SIZE_IN_BITS==32 -- | a.k.a "Register64" -- Reg is the lower 32-bit temporary which contains the result. -- Use getHiVRegFromLo to find the other VRegUnique. @@ -187,6 +192,7 @@ data ChildCode64 = ChildCode64 InstrBlock Reg +#endif -- | Register's passed up the tree. If the stix code forces the register @@ -286,9 +292,7 @@ getSomeReg expr = do return (reg, code) - - - +#if WORD_SIZE_IN_BITS==32 assignMem_I64Code :: CmmExpr -> CmmExpr -> NatM InstrBlock assignMem_I64Code addrTree valueTree = do Amode addr addr_code <- getAmode addrTree @@ -321,8 +325,6 @@ assignReg_I64Code _ _ = panic "assignReg_I64Code(i386): invalid lvalue" - - iselExpr64 :: CmmExpr -> NatM ChildCode64 iselExpr64 (CmmLit (CmmInt i _)) = do (rlo,rhi) <- getNewRegPairNat II32 @@ -396,7 +398,7 @@ iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr]) = do iselExpr64 expr = pprPanic "iselExpr64(i386)" (ppr expr) - +#endif -------------------------------------------------------------------------------- @@ -1798,7 +1800,7 @@ genCCall target dest_regs args = do where rep = localRegType dest r_dest = getRegisterReg True (CmmLocal dest) - assign_code many = panic "genCCall.assign_code many" + assign_code _many = panic "genCCall.assign_code many" return (load_args_code `appOL` adjust_rsp `appOL` @@ -1840,7 +1842,7 @@ genCCall target dest_regs args = do return ((CmmHinted arg hint):args', ars, frs, code') push_args [] code = return code - push_args ((CmmHinted arg hint):rest) code + push_args ((CmmHinted arg _):rest) code | isFloatType arg_rep = do (arg_reg, arg_code) <- getSomeReg arg delta <- getDeltaNat @@ -1969,10 +1971,7 @@ genSwitch expr ids -- conjunction with the hack in PprMach.hs/pprDataItem once -- binutils 2.17 is standard. code = e_code `appOL` t_code `appOL` toOL [ - MOVSxL II32 - (OpAddr (AddrBaseIndex (EABaseReg tableReg) - (EAIndex reg wORD_SIZE) (ImmInt 0))) - (OpReg reg), + MOVSxL II32 op (OpReg reg), ADD (intSize wordWidth) (OpReg reg) (OpReg tableReg), JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl ] @@ -1988,8 +1987,7 @@ genSwitch expr ids = do (reg,e_code) <- getSomeReg expr lbl <- getNewLabelNat - let - op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg wORD_SIZE) (ImmCLbl lbl)) + let op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg wORD_SIZE) (ImmCLbl lbl)) code = e_code `appOL` toOL [ JMP_TBL op ids ReadOnlyData lbl ] _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
