diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs index f49155e827dc..41efa187532b 100644 --- a/compiler/nativeGen/RegAlloc/Liveness.hs +++ b/compiler/nativeGen/RegAlloc/Liveness.hs @@ -2,7 +2,7 @@ -- -- The register liveness determinator -- --- (c) The University of Glasgow 2004 +-- (c) The University of Glasgow 2004-2013 -- ----------------------------------------------------------------------------- module RegAlloc.Liveness ( @@ -423,7 +423,7 @@ slurpReloadCoalesce live , slotMap' <- addToUFM slotMap slot reg = return (slotMap', Nothing) - -- add an edge betwen the this reg and the last one stored into the slot + -- add an edge between the this reg and the last one stored into the slot | LiveInstr (RELOAD slot reg) _ <- li = case lookupUFM slotMap slot of Just reg2 @@ -594,7 +594,7 @@ patchEraseLive patchF cmm -- source and destination regs are the same | r1 == r2 = True - -- desination reg is never used + -- destination reg is never used | elementOfUniqSet r2 (liveBorn live) , elementOfUniqSet r2 (liveDieRead live) || elementOfUniqSet r2 (liveDieWrite live) = True diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs index c6497e12480d..30ffcd9d9a38 100644 --- a/compiler/nativeGen/SPARC/CodeGen.hs +++ b/compiler/nativeGen/SPARC/CodeGen.hs @@ -2,7 +2,7 @@ -- -- Generating machine code (instruction selection) -- --- (c) The University of Glasgow 1996-2004 +-- (c) The University of Glasgow 1996-2013 -- ----------------------------------------------------------------------------- @@ -538,7 +538,7 @@ move_final (v:vs) (a:az) offset -- | Assign results returned from the call into their --- desination regs. +-- destination regs. -- assign_code :: Platform -> [LocalReg] -> OrdList Instr diff --git a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs index 7b39a371d76c..438deba00a3b 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Gen64.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Gen64.hs @@ -1,16 +1,8 @@ - -{-# OPTIONS -fno-warn-tabs #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and --- detab the module (please do the detabbing in a separate patch). See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - -- | Evaluation of 64 bit values on 32 bit platforms. module SPARC.CodeGen.Gen64 ( - assignMem_I64Code, - assignReg_I64Code, - iselExpr64 + assignMem_I64Code, + assignReg_I64Code, + iselExpr64 ) where @@ -36,13 +28,13 @@ import Outputable -- | Code to assign a 64 bit value to memory. assignMem_I64Code - :: CmmExpr -- ^ expr producing the desination address - -> CmmExpr -- ^ expr producing the source value. - -> NatM InstrBlock + :: CmmExpr -- ^ expr producing the destination address + -> CmmExpr -- ^ expr producing the source value. + -> NatM InstrBlock assignMem_I64Code addrTree valueTree = do - ChildCode64 vcode rlo <- iselExpr64 valueTree + ChildCode64 vcode rlo <- iselExpr64 valueTree (src, acode) <- getSomeReg addrTree let @@ -52,25 +44,25 @@ assignMem_I64Code addrTree valueTree mov_hi = ST II32 rhi (AddrRegImm src (ImmInt 0)) mov_lo = ST II32 rlo (AddrRegImm src (ImmInt 4)) - code = vcode `appOL` acode `snocOL` mov_hi `snocOL` mov_lo + code = vcode `appOL` acode `snocOL` mov_hi `snocOL` mov_lo {- pprTrace "assignMem_I64Code" - (vcat [ text "addrTree: " <+> ppr addrTree - , text "valueTree: " <+> ppr valueTree - , text "vcode:" - , vcat $ map ppr $ fromOL vcode - , text "" - , text "acode:" - , vcat $ map ppr $ fromOL acode ]) + (vcat [ text "addrTree: " <+> ppr addrTree + , text "valueTree: " <+> ppr valueTree + , text "vcode:" + , vcat $ map ppr $ fromOL vcode + , text "" + , text "acode:" + , vcat $ map ppr $ fromOL acode ]) $ -} return code -- | Code to assign a 64 bit value to a register. assignReg_I64Code - :: CmmReg -- ^ the destination register - -> CmmExpr -- ^ expr producing the source value - -> NatM InstrBlock + :: CmmReg -- ^ the destination register + -> CmmExpr -- ^ expr producing the source value + -> NatM InstrBlock assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do @@ -98,73 +90,73 @@ iselExpr64 :: CmmExpr -> NatM ChildCode64 -- Load a 64 bit word iselExpr64 (CmmLoad addrTree ty) | isWord64 ty - = do Amode amode addr_code <- getAmode addrTree - let result - - | AddrRegReg r1 r2 <- amode - = do rlo <- getNewRegNat II32 - tmp <- getNewRegNat II32 - let rhi = getHiVRegFromLo rlo - - return $ ChildCode64 - ( addr_code - `appOL` toOL - [ ADD False False r1 (RIReg r2) tmp - , LD II32 (AddrRegImm tmp (ImmInt 0)) rhi - , LD II32 (AddrRegImm tmp (ImmInt 4)) rlo ]) - rlo - - | AddrRegImm r1 (ImmInt i) <- amode - = do rlo <- getNewRegNat II32 - let rhi = getHiVRegFromLo rlo - - return $ ChildCode64 - ( addr_code - `appOL` toOL - [ LD II32 (AddrRegImm r1 (ImmInt $ 0 + i)) rhi - , LD II32 (AddrRegImm r1 (ImmInt $ 4 + i)) rlo ]) - rlo - - | otherwise - = panic "SPARC.CodeGen.Gen64: no match" - - result + = do Amode amode addr_code <- getAmode addrTree + let result + + | AddrRegReg r1 r2 <- amode + = do rlo <- getNewRegNat II32 + tmp <- getNewRegNat II32 + let rhi = getHiVRegFromLo rlo + + return $ ChildCode64 + ( addr_code + `appOL` toOL + [ ADD False False r1 (RIReg r2) tmp + , LD II32 (AddrRegImm tmp (ImmInt 0)) rhi + , LD II32 (AddrRegImm tmp (ImmInt 4)) rlo ]) + rlo + + | AddrRegImm r1 (ImmInt i) <- amode + = do rlo <- getNewRegNat II32 + let rhi = getHiVRegFromLo rlo + + return $ ChildCode64 + ( addr_code + `appOL` toOL + [ LD II32 (AddrRegImm r1 (ImmInt $ 0 + i)) rhi + , LD II32 (AddrRegImm r1 (ImmInt $ 4 + i)) rlo ]) + rlo + + | otherwise + = panic "SPARC.CodeGen.Gen64: no match" + + result -- Add a literal to a 64 bit integer iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)]) - = do ChildCode64 code1 r1_lo <- iselExpr64 e1 - let r1_hi = getHiVRegFromLo r1_lo - - r_dst_lo <- getNewRegNat II32 - let r_dst_hi = getHiVRegFromLo r_dst_lo - - let code = code1 - `appOL` toOL - [ ADD False True r1_lo (RIImm (ImmInteger i)) r_dst_lo - , ADD True False r1_hi (RIReg g0) r_dst_hi ] - - return $ ChildCode64 code r_dst_lo + = do ChildCode64 code1 r1_lo <- iselExpr64 e1 + let r1_hi = getHiVRegFromLo r1_lo + + r_dst_lo <- getNewRegNat II32 + let r_dst_hi = getHiVRegFromLo r_dst_lo + + let code = code1 + `appOL` toOL + [ ADD False True r1_lo (RIImm (ImmInteger i)) r_dst_lo + , ADD True False r1_hi (RIReg g0) r_dst_hi ] + + return $ ChildCode64 code r_dst_lo -- Addition of II64 iselExpr64 (CmmMachOp (MO_Add _) [e1, e2]) - = do ChildCode64 code1 r1_lo <- iselExpr64 e1 - let r1_hi = getHiVRegFromLo r1_lo - - ChildCode64 code2 r2_lo <- iselExpr64 e2 - let r2_hi = getHiVRegFromLo r2_lo - - r_dst_lo <- getNewRegNat II32 - let r_dst_hi = getHiVRegFromLo r_dst_lo - - let code = code1 - `appOL` code2 - `appOL` toOL - [ ADD False True r1_lo (RIReg r2_lo) r_dst_lo - , ADD True False r1_hi (RIReg r2_hi) r_dst_hi ] - - return $ ChildCode64 code r_dst_lo + = do ChildCode64 code1 r1_lo <- iselExpr64 e1 + let r1_hi = getHiVRegFromLo r1_lo + + ChildCode64 code2 r2_lo <- iselExpr64 e2 + let r2_hi = getHiVRegFromLo r2_lo + + r_dst_lo <- getNewRegNat II32 + let r_dst_hi = getHiVRegFromLo r_dst_lo + + let code = code1 + `appOL` code2 + `appOL` toOL + [ ADD False True r1_lo (RIReg r2_lo) r_dst_lo + , ADD True False r1_hi (RIReg r2_hi) r_dst_hi ] + + return $ ChildCode64 code r_dst_lo iselExpr64 (CmmReg (CmmLocal (LocalReg uq ty))) @@ -184,20 +176,20 @@ iselExpr64 (CmmReg (CmmLocal (LocalReg uq ty))) -- Convert something into II64 iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr]) = do - r_dst_lo <- getNewRegNat II32 - let r_dst_hi = getHiVRegFromLo r_dst_lo - - -- compute expr and load it into r_dst_lo - (a_reg, a_code) <- getSomeReg expr - - dflags <- getDynFlags - let platform = targetPlatform dflags - code = a_code - `appOL` toOL - [ mkRegRegMoveInstr platform g0 r_dst_hi -- clear high 32 bits - , mkRegRegMoveInstr platform a_reg r_dst_lo ] - - return $ ChildCode64 code r_dst_lo + r_dst_lo <- getNewRegNat II32 + let r_dst_hi = getHiVRegFromLo r_dst_lo + + -- compute expr and load it into r_dst_lo + (a_reg, a_code) <- getSomeReg expr + + dflags <- getDynFlags + let platform = targetPlatform dflags + code = a_code + `appOL` toOL + [ mkRegRegMoveInstr platform g0 r_dst_hi -- clear high 32 bits + , mkRegRegMoveInstr platform a_reg r_dst_lo ] + + return $ ChildCode64 code r_dst_lo iselExpr64 expr