module GHC.CmmToAsm.SPARC.CodeGen.Base (
InstrBlock,
CondCode(..),
ChildCode64(..),
Amode(..),
Register(..),
setFormatOfRegister,
getRegisterReg,
mangleIndexTree
)
where
import GHC.Prelude
import GHC.CmmToAsm.SPARC.Instr
import GHC.CmmToAsm.SPARC.Cond
import GHC.CmmToAsm.SPARC.AddrMode
import GHC.CmmToAsm.SPARC.Regs
import GHC.CmmToAsm.Format
import GHC.Platform.Reg
import GHC.Platform.Regs
import GHC.Cmm
import GHC.Cmm.Ppr.Expr ()
import GHC.Platform
import GHC.Utils.Outputable
import GHC.Data.OrdList
type InstrBlock
= OrdList Instr
data CondCode
= CondCode Bool Cond InstrBlock
data ChildCode64
= ChildCode64
InstrBlock
Reg
data Amode
= Amode
AddrMode
InstrBlock
data Register
= Fixed Format Reg InstrBlock
| Any Format (Reg -> InstrBlock)
setFormatOfRegister
:: Register -> Format -> Register
setFormatOfRegister reg format
= case reg of
Fixed _ reg code -> Fixed format reg code
Any _ codefn -> Any format codefn
getRegisterReg :: Platform -> CmmReg -> Reg
getRegisterReg _ (CmmLocal (LocalReg u pk))
= RegVirtual $ mkVirtualReg u (cmmTypeFormat pk)
getRegisterReg platform (CmmGlobal mid)
= case globalRegMaybe platform mid of
Just reg -> RegReal reg
Nothing -> pprPanic
"SPARC.CodeGen.Base.getRegisterReg: global is in memory"
(ppr $ CmmGlobal mid)
mangleIndexTree :: Platform -> CmmExpr -> CmmExpr
mangleIndexTree platform (CmmRegOff reg off)
= CmmMachOp (MO_Add width) [CmmReg reg, CmmLit (CmmInt (fromIntegral off) width)]
where width = typeWidth (cmmRegType platform reg)
mangleIndexTree _ _
= panic "SPARC.CodeGen.Base.mangleIndexTree: no match"