{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.CmmToAsm.SPARC.CodeGen.Expand (
expandTop
)
where
import GHC.Prelude
import GHC.CmmToAsm.SPARC.Instr
import GHC.CmmToAsm.SPARC.Imm
import GHC.CmmToAsm.SPARC.AddrMode
import GHC.CmmToAsm.SPARC.Regs
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Types
import GHC.Cmm
import GHC.Platform.Reg
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Data.OrdList
expandTop :: NatCmmDecl RawCmmStatics Instr -> NatCmmDecl RawCmmStatics Instr
expandTop :: NatCmmDecl RawCmmStatics Instr -> NatCmmDecl RawCmmStatics Instr
expandTop top :: NatCmmDecl RawCmmStatics Instr
top@(CmmData{})
= NatCmmDecl RawCmmStatics Instr
top
expandTop (CmmProc LabelMap RawCmmStatics
info CLabel
lbl [GlobalReg]
live (ListGraph [GenBasicBlock Instr]
blocks))
= forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LabelMap RawCmmStatics
info CLabel
lbl [GlobalReg]
live (forall i. [GenBasicBlock i] -> ListGraph i
ListGraph forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map GenBasicBlock Instr -> GenBasicBlock Instr
expandBlock [GenBasicBlock Instr]
blocks)
expandBlock :: NatBasicBlock Instr -> NatBasicBlock Instr
expandBlock :: GenBasicBlock Instr -> GenBasicBlock Instr
expandBlock (BasicBlock BlockId
label [Instr]
instrs)
= let instrs_ol :: OrdList Instr
instrs_ol = [Instr] -> OrdList Instr
expandBlockInstrs [Instr]
instrs
instrs' :: [Instr]
instrs' = forall a. OrdList a -> [a]
fromOL OrdList Instr
instrs_ol
in forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
label [Instr]
instrs'
expandBlockInstrs :: [Instr] -> OrdList Instr
expandBlockInstrs :: [Instr] -> OrdList Instr
expandBlockInstrs [] = forall a. OrdList a
nilOL
expandBlockInstrs (Instr
ii:[Instr]
is)
= let ii_doubleRegs :: Instr
ii_doubleRegs = Instr -> Instr
remapRegPair Instr
ii
is_misaligned :: OrdList Instr
is_misaligned = Instr -> OrdList Instr
expandMisalignedDoubles Instr
ii_doubleRegs
in OrdList Instr
is_misaligned forall a. OrdList a -> OrdList a -> OrdList a
`appOL` [Instr] -> OrdList Instr
expandBlockInstrs [Instr]
is
remapRegPair :: Instr -> Instr
remapRegPair :: Instr -> Instr
remapRegPair Instr
instr
= let patchF :: Reg -> Reg
patchF Reg
reg
= case Reg
reg of
RegReal (RealRegSingle RegNo
_)
-> Reg
reg
RegReal (RealRegPair RegNo
r1 RegNo
r2)
| RegNo
r1 forall a. Ord a => a -> a -> Bool
>= RegNo
32
, RegNo
r1 forall a. Ord a => a -> a -> Bool
<= RegNo
63
, RegNo
r1 forall a. Integral a => a -> a -> a
`mod` RegNo
2 forall a. Eq a => a -> a -> Bool
== RegNo
0
, RegNo
r2 forall a. Eq a => a -> a -> Bool
== RegNo
r1 forall a. Num a => a -> a -> a
+ RegNo
1
-> RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
r1)
| Bool
otherwise
-> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.CodeGen.Expand: not remapping dodgy looking reg pair " (forall a. Outputable a => a -> SDoc
ppr Reg
reg)
RegVirtual VirtualReg
_
-> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.CodeGen.Expand: not remapping virtual reg " (forall a. Outputable a => a -> SDoc
ppr Reg
reg)
in Instr -> (Reg -> Reg) -> Instr
patchRegsOfInstr Instr
instr Reg -> Reg
patchF
expandMisalignedDoubles :: Instr -> OrdList Instr
expandMisalignedDoubles :: Instr -> OrdList Instr
expandMisalignedDoubles Instr
instr
| LD Format
FF64 (AddrRegReg Reg
r1 Reg
r2) Reg
fReg <- Instr
instr
= forall a. [a] -> OrdList a
toOL [ Bool -> Bool -> Reg -> RI -> Reg -> Instr
ADD Bool
False Bool
False Reg
r1 (Reg -> RI
RIReg Reg
r2) Reg
r1
, Format -> AddrMode -> Reg -> Instr
LD Format
FF32 (Reg -> Reg -> AddrMode
AddrRegReg Reg
r1 Reg
g0) Reg
fReg
, Format -> AddrMode -> Reg -> Instr
LD Format
FF32 (Reg -> Imm -> AddrMode
AddrRegImm Reg
r1 (RegNo -> Imm
ImmInt RegNo
4)) (Reg -> Reg
fRegHi Reg
fReg)
, Bool -> Bool -> Reg -> RI -> Reg -> Instr
SUB Bool
False Bool
False Reg
r1 (Reg -> RI
RIReg Reg
r2) Reg
r1 ]
| LD Format
FF64 AddrMode
addr Reg
fReg <- Instr
instr
= let Just AddrMode
addr' = AddrMode -> RegNo -> Maybe AddrMode
addrOffset AddrMode
addr RegNo
4
in forall a. [a] -> OrdList a
toOL [ Format -> AddrMode -> Reg -> Instr
LD Format
FF32 AddrMode
addr Reg
fReg
, Format -> AddrMode -> Reg -> Instr
LD Format
FF32 AddrMode
addr' (Reg -> Reg
fRegHi Reg
fReg) ]
| ST Format
FF64 Reg
fReg (AddrRegReg Reg
r1 Reg
r2) <- Instr
instr
= forall a. [a] -> OrdList a
toOL [ Bool -> Bool -> Reg -> RI -> Reg -> Instr
ADD Bool
False Bool
False Reg
r1 (Reg -> RI
RIReg Reg
r2) Reg
r1
, Format -> Reg -> AddrMode -> Instr
ST Format
FF32 Reg
fReg (Reg -> Reg -> AddrMode
AddrRegReg Reg
r1 Reg
g0)
, Format -> Reg -> AddrMode -> Instr
ST Format
FF32 (Reg -> Reg
fRegHi Reg
fReg) (Reg -> Imm -> AddrMode
AddrRegImm Reg
r1 (RegNo -> Imm
ImmInt RegNo
4))
, Bool -> Bool -> Reg -> RI -> Reg -> Instr
SUB Bool
False Bool
False Reg
r1 (Reg -> RI
RIReg Reg
r2) Reg
r1 ]
| ST Format
FF64 Reg
fReg AddrMode
addr <- Instr
instr
= let Just AddrMode
addr' = AddrMode -> RegNo -> Maybe AddrMode
addrOffset AddrMode
addr RegNo
4
in forall a. [a] -> OrdList a
toOL [ Format -> Reg -> AddrMode -> Instr
ST Format
FF32 Reg
fReg AddrMode
addr
, Format -> Reg -> AddrMode -> Instr
ST Format
FF32 (Reg -> Reg
fRegHi Reg
fReg) AddrMode
addr' ]
| Bool
otherwise
= forall a. a -> OrdList a
unitOL Instr
instr
fRegHi :: Reg -> Reg
fRegHi :: Reg -> Reg
fRegHi (RegReal (RealRegSingle RegNo
r1))
| RegNo
r1 forall a. Ord a => a -> a -> Bool
>= RegNo
32
, RegNo
r1 forall a. Ord a => a -> a -> Bool
<= RegNo
63
, RegNo
r1 forall a. Integral a => a -> a -> a
`mod` RegNo
2 forall a. Eq a => a -> a -> Bool
== RegNo
0
= (RealReg -> Reg
RegReal forall a b. (a -> b) -> a -> b
$ RegNo -> RealReg
RealRegSingle (RegNo
r1 forall a. Num a => a -> a -> a
+ RegNo
1))
fRegHi Reg
reg
= forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.CodeGen.Expand: can't take fRegHi from " (forall a. Outputable a => a -> SDoc
ppr Reg
reg)