diff options
author | Austin Seipp <austin@well-typed.com> | 2014-07-18 22:29:21 -0500 |
---|---|---|
committer | Austin Seipp <austin@well-typed.com> | 2014-07-20 16:55:50 -0500 |
commit | 085713f46cdfdc2e3e9d75a9c8c96fbd80f88f71 (patch) | |
tree | db7573d47e067315ea3c36869b1c530a968363d0 /compiler/nativeGen/SPARC | |
parent | 6babdc824319d01d4836973defecca1ae3284e97 (diff) | |
download | haskell-085713f46cdfdc2e3e9d75a9c8c96fbd80f88f71.tar.gz |
nativeGen: detabify/dewhitespace SPARC/CodeGen/Expand
Signed-off-by: Austin Seipp <austin@well-typed.com>
Diffstat (limited to 'compiler/nativeGen/SPARC')
-rw-r--r-- | compiler/nativeGen/SPARC/CodeGen/Expand.hs | 197 |
1 files changed, 91 insertions, 106 deletions
diff --git a/compiler/nativeGen/SPARC/CodeGen/Expand.hs b/compiler/nativeGen/SPARC/CodeGen/Expand.hs index 7ebc2f6630..1d4d1379a5 100644 --- a/compiler/nativeGen/SPARC/CodeGen/Expand.hs +++ b/compiler/nativeGen/SPARC/CodeGen/Expand.hs @@ -1,14 +1,6 @@ - -{-# OPTIONS_GHC -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://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces --- for details - -- | Expand out synthetic instructions into single machine instrs. module SPARC.CodeGen.Expand ( - expandTop + expandTop ) where @@ -17,7 +9,7 @@ import SPARC.Instr import SPARC.Imm import SPARC.AddrMode import SPARC.Regs -import SPARC.Ppr () +import SPARC.Ppr () import Instruction import Reg import Size @@ -30,139 +22,132 @@ import OrdList -- | Expand out synthetic instructions in this top level thing expandTop :: NatCmmDecl CmmStatics Instr -> NatCmmDecl CmmStatics Instr expandTop top@(CmmData{}) - = top + = top expandTop (CmmProc info lbl live (ListGraph blocks)) - = CmmProc info lbl live (ListGraph $ map expandBlock blocks) + = CmmProc info lbl live (ListGraph $ map expandBlock blocks) -- | Expand out synthetic instructions in this block expandBlock :: NatBasicBlock Instr -> NatBasicBlock Instr expandBlock (BasicBlock label instrs) - = let instrs_ol = expandBlockInstrs instrs - instrs' = fromOL instrs_ol - in BasicBlock label instrs' + = let instrs_ol = expandBlockInstrs instrs + instrs' = fromOL instrs_ol + in BasicBlock label instrs' -- | Expand out some instructions expandBlockInstrs :: [Instr] -> OrdList Instr -expandBlockInstrs [] = nilOL - +expandBlockInstrs [] = nilOL + expandBlockInstrs (ii:is) - = let ii_doubleRegs = remapRegPair ii - is_misaligned = expandMisalignedDoubles ii_doubleRegs + = let ii_doubleRegs = remapRegPair ii + is_misaligned = expandMisalignedDoubles ii_doubleRegs + + in is_misaligned `appOL` expandBlockInstrs is - in is_misaligned `appOL` expandBlockInstrs is - -- | In the SPARC instruction set the FP register pairs that are used --- to hold 64 bit floats are refered to by just the first reg --- of the pair. Remap our internal reg pairs to the appropriate reg. +-- to hold 64 bit floats are refered to by just the first reg +-- of the pair. Remap our internal reg pairs to the appropriate reg. -- --- For example: --- ldd [%l1], (%f0 | %f1) +-- For example: +-- ldd [%l1], (%f0 | %f1) -- --- gets mapped to --- ldd [$l1], %f0 +-- gets mapped to +-- ldd [$l1], %f0 -- remapRegPair :: Instr -> Instr remapRegPair instr - = let patchF reg - = case reg of - RegReal (RealRegSingle _) - -> reg + = let patchF reg + = case reg of + RegReal (RealRegSingle _) + -> reg - RegReal (RealRegPair r1 r2) + RegReal (RealRegPair r1 r2) - -- sanity checking - | r1 >= 32 - , r1 <= 63 - , r1 `mod` 2 == 0 - , r2 == r1 + 1 - -> RegReal (RealRegSingle r1) + -- sanity checking + | r1 >= 32 + , r1 <= 63 + , r1 `mod` 2 == 0 + , r2 == r1 + 1 + -> RegReal (RealRegSingle r1) - | otherwise - -> pprPanic "SPARC.CodeGen.Expand: not remapping dodgy looking reg pair " (ppr reg) + | otherwise + -> pprPanic "SPARC.CodeGen.Expand: not remapping dodgy looking reg pair " (ppr reg) - RegVirtual _ - -> pprPanic "SPARC.CodeGen.Expand: not remapping virtual reg " (ppr reg) - - in patchRegsOfInstr instr patchF + RegVirtual _ + -> pprPanic "SPARC.CodeGen.Expand: not remapping virtual reg " (ppr reg) + + in patchRegsOfInstr instr patchF -- Expand out 64 bit load/stores into individual instructions to handle --- possible double alignment problems. +-- possible double alignment problems. -- --- TODO: It'd be better to use a scratch reg instead of the add/sub thing. --- We might be able to do this faster if we use the UA2007 instr set --- instead of restricting ourselves to SPARC V9. +-- TODO: It'd be better to use a scratch reg instead of the add/sub thing. +-- We might be able to do this faster if we use the UA2007 instr set +-- instead of restricting ourselves to SPARC V9. -- expandMisalignedDoubles :: Instr -> OrdList Instr expandMisalignedDoubles instr - -- Translate to: - -- add g1,g2,g1 - -- ld [g1],%fn - -- ld [g1+4],%f(n+1) - -- sub g1,g2,g1 -- to restore g1 - | LD FF64 (AddrRegReg r1 r2) fReg <- instr - = toOL [ ADD False False r1 (RIReg r2) r1 - , LD FF32 (AddrRegReg r1 g0) fReg - , LD FF32 (AddrRegImm r1 (ImmInt 4)) (fRegHi fReg) - , SUB False False r1 (RIReg r2) r1 ] - - -- Translate to - -- ld [addr],%fn - -- ld [addr+4],%f(n+1) - | LD FF64 addr fReg <- instr - = let Just addr' = addrOffset addr 4 - in toOL [ LD FF32 addr fReg - , LD FF32 addr' (fRegHi fReg) ] - - -- Translate to: - -- add g1,g2,g1 - -- st %fn,[g1] - -- st %f(n+1),[g1+4] - -- sub g1,g2,g1 -- to restore g1 - | ST FF64 fReg (AddrRegReg r1 r2) <- instr - = toOL [ ADD False False r1 (RIReg r2) r1 - , ST FF32 fReg (AddrRegReg r1 g0) - , ST FF32 (fRegHi fReg) (AddrRegImm r1 (ImmInt 4)) - , SUB False False r1 (RIReg r2) r1 ] - - -- Translate to - -- ld [addr],%fn - -- ld [addr+4],%f(n+1) - | ST FF64 fReg addr <- instr - = let Just addr' = addrOffset addr 4 - in toOL [ ST FF32 fReg addr - , ST FF32 (fRegHi fReg) addr' ] - - -- some other instr - | otherwise - = unitOL instr - - - --- | The the high partner for this float reg. + -- Translate to: + -- add g1,g2,g1 + -- ld [g1],%fn + -- ld [g1+4],%f(n+1) + -- sub g1,g2,g1 -- to restore g1 + | LD FF64 (AddrRegReg r1 r2) fReg <- instr + = toOL [ ADD False False r1 (RIReg r2) r1 + , LD FF32 (AddrRegReg r1 g0) fReg + , LD FF32 (AddrRegImm r1 (ImmInt 4)) (fRegHi fReg) + , SUB False False r1 (RIReg r2) r1 ] + + -- Translate to + -- ld [addr],%fn + -- ld [addr+4],%f(n+1) + | LD FF64 addr fReg <- instr + = let Just addr' = addrOffset addr 4 + in toOL [ LD FF32 addr fReg + , LD FF32 addr' (fRegHi fReg) ] + + -- Translate to: + -- add g1,g2,g1 + -- st %fn,[g1] + -- st %f(n+1),[g1+4] + -- sub g1,g2,g1 -- to restore g1 + | ST FF64 fReg (AddrRegReg r1 r2) <- instr + = toOL [ ADD False False r1 (RIReg r2) r1 + , ST FF32 fReg (AddrRegReg r1 g0) + , ST FF32 (fRegHi fReg) (AddrRegImm r1 (ImmInt 4)) + , SUB False False r1 (RIReg r2) r1 ] + + -- Translate to + -- ld [addr],%fn + -- ld [addr+4],%f(n+1) + | ST FF64 fReg addr <- instr + = let Just addr' = addrOffset addr 4 + in toOL [ ST FF32 fReg addr + , ST FF32 (fRegHi fReg) addr' ] + + -- some other instr + | otherwise + = unitOL instr + + + +-- | The the high partner for this float reg. fRegHi :: Reg -> Reg fRegHi (RegReal (RealRegSingle r1)) - | r1 >= 32 - , r1 <= 63 - , r1 `mod` 2 == 0 - = (RegReal $ RealRegSingle (r1 + 1)) - + | r1 >= 32 + , r1 <= 63 + , r1 `mod` 2 == 0 + = (RegReal $ RealRegSingle (r1 + 1)) + -- Can't take high partner for non-low reg. fRegHi reg - = pprPanic "SPARC.CodeGen.Expand: can't take fRegHi from " (ppr reg) - - - - - - - + = pprPanic "SPARC.CodeGen.Expand: can't take fRegHi from " (ppr reg) |