{-# 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))
= LabelMap RawCmmStatics
-> CLabel
-> [GlobalReg]
-> ListGraph Instr
-> NatCmmDecl RawCmmStatics Instr
forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LabelMap RawCmmStatics
info CLabel
lbl [GlobalReg]
live ([GenBasicBlock Instr] -> ListGraph Instr
forall i. [GenBasicBlock i] -> ListGraph i
ListGraph ([GenBasicBlock Instr] -> ListGraph Instr)
-> [GenBasicBlock Instr] -> ListGraph Instr
forall a b. (a -> b) -> a -> b
$ (GenBasicBlock Instr -> GenBasicBlock Instr)
-> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
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' = OrdList Instr -> [Instr]
forall a. OrdList a -> [a]
fromOL OrdList Instr
instrs_ol
in BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
label [Instr]
instrs'
expandBlockInstrs :: [Instr] -> OrdList Instr
expandBlockInstrs :: [Instr] -> OrdList Instr
expandBlockInstrs [] = OrdList Instr
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 OrdList Instr -> OrdList Instr -> OrdList Instr
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 RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= RegNo
32
, RegNo
r1 RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
<= RegNo
63
, RegNo
r1 RegNo -> RegNo -> RegNo
forall a. Integral a => a -> a -> a
`mod` RegNo
2 RegNo -> RegNo -> Bool
forall a. Eq a => a -> a -> Bool
== RegNo
0
, RegNo
r2 RegNo -> RegNo -> Bool
forall a. Eq a => a -> a -> Bool
== RegNo
r1 RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
+ RegNo
1
-> RealReg -> Reg
RegReal (RegNo -> RealReg
RealRegSingle RegNo
r1)
| Bool
otherwise
-> String -> SDoc -> Reg
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.CodeGen.Expand: not remapping dodgy looking reg pair " (Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
reg)
RegVirtual VirtualReg
_
-> String -> SDoc -> Reg
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.CodeGen.Expand: not remapping virtual reg " (Reg -> SDoc
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
= [Instr] -> OrdList 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 [Instr] -> OrdList Instr
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
= [Instr] -> OrdList 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 [Instr] -> OrdList Instr
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
= Instr -> OrdList Instr
forall a. a -> OrdList a
unitOL Instr
instr
fRegHi :: Reg -> Reg
fRegHi :: Reg -> Reg
fRegHi (RegReal (RealRegSingle RegNo
r1))
| RegNo
r1 RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
>= RegNo
32
, RegNo
r1 RegNo -> RegNo -> Bool
forall a. Ord a => a -> a -> Bool
<= RegNo
63
, RegNo
r1 RegNo -> RegNo -> RegNo
forall a. Integral a => a -> a -> a
`mod` RegNo
2 RegNo -> RegNo -> Bool
forall a. Eq a => a -> a -> Bool
== RegNo
0
= (RealReg -> Reg
RegReal (RealReg -> Reg) -> RealReg -> Reg
forall a b. (a -> b) -> a -> b
$ RegNo -> RealReg
RealRegSingle (RegNo
r1 RegNo -> RegNo -> RegNo
forall a. Num a => a -> a -> a
+ RegNo
1))
fRegHi Reg
reg
= String -> SDoc -> Reg
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"SPARC.CodeGen.Expand: can't take fRegHi from " (Reg -> SDoc
forall a. Outputable a => a -> SDoc
ppr Reg
reg)