module GHC.CmmToAsm.Reg.Linear.FreeRegs (
FR(..),
allFreeRegs,
maxSpillSlots
)
where
import GHC.Prelude
import GHC.Platform.Reg
import GHC.Platform.Reg.Class
import qualified GHC.Platform.Reg.Class.Unified as Unified
import qualified GHC.Platform.Reg.Class.Separate as Separate
import qualified GHC.Platform.Reg.Class.NoVectors as NoVectors
import GHC.CmmToAsm.Config
import GHC.Utils.Panic
import GHC.Platform
import qualified GHC.CmmToAsm.Reg.Linear.PPC as PPC
import qualified GHC.CmmToAsm.Reg.Linear.X86 as X86
import qualified GHC.CmmToAsm.Reg.Linear.X86_64 as X86_64
import qualified GHC.CmmToAsm.Reg.Linear.AArch64 as AArch64
import qualified GHC.CmmToAsm.Reg.Linear.RV64 as RV64
import qualified GHC.CmmToAsm.PPC.Instr as PPC.Instr
import qualified GHC.CmmToAsm.X86.Instr as X86.Instr
import qualified GHC.CmmToAsm.AArch64.Instr as AArch64.Instr
import qualified GHC.CmmToAsm.RV64.Instr as RV64.Instr
class Show freeRegs => FR freeRegs where
frAllocateReg :: Platform -> RealReg -> freeRegs -> freeRegs
frGetFreeRegs :: Platform -> RegClass -> freeRegs -> [RealReg]
frInitFreeRegs :: Platform -> freeRegs
frReleaseReg :: Platform -> RealReg -> freeRegs -> freeRegs
instance FR X86.FreeRegs where
frAllocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frAllocateReg = \Platform
_ -> RealReg -> FreeRegs -> FreeRegs
X86.allocateReg
frGetFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg]
frGetFreeRegs = Platform -> RegClass -> FreeRegs -> [RealReg]
X86.getFreeRegs
frInitFreeRegs :: Platform -> FreeRegs
frInitFreeRegs = Platform -> FreeRegs
X86.initFreeRegs
frReleaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frReleaseReg = \Platform
_ -> RealReg -> FreeRegs -> FreeRegs
X86.releaseReg
instance FR X86_64.FreeRegs where
frAllocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frAllocateReg = \Platform
_ -> RealReg -> FreeRegs -> FreeRegs
X86_64.allocateReg
frGetFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg]
frGetFreeRegs = Platform -> RegClass -> FreeRegs -> [RealReg]
X86_64.getFreeRegs
frInitFreeRegs :: Platform -> FreeRegs
frInitFreeRegs = Platform -> FreeRegs
X86_64.initFreeRegs
frReleaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frReleaseReg = \Platform
_ -> RealReg -> FreeRegs -> FreeRegs
X86_64.releaseReg
instance FR PPC.FreeRegs where
frAllocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frAllocateReg = \Platform
_ -> RealReg -> FreeRegs -> FreeRegs
PPC.allocateReg
frGetFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg]
frGetFreeRegs = \Platform
_ -> RegClass -> FreeRegs -> [RealReg]
PPC.getFreeRegs
frInitFreeRegs :: Platform -> FreeRegs
frInitFreeRegs = Platform -> FreeRegs
PPC.initFreeRegs
frReleaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frReleaseReg = \Platform
_ -> RealReg -> FreeRegs -> FreeRegs
PPC.releaseReg
instance FR AArch64.FreeRegs where
frAllocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frAllocateReg = \Platform
_ -> HasDebugCallStack => RealReg -> FreeRegs -> FreeRegs
RealReg -> FreeRegs -> FreeRegs
AArch64.allocateReg
frGetFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg]
frGetFreeRegs = \Platform
_ -> RegClass -> FreeRegs -> [RealReg]
AArch64.getFreeRegs
frInitFreeRegs :: Platform -> FreeRegs
frInitFreeRegs = Platform -> FreeRegs
AArch64.initFreeRegs
frReleaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frReleaseReg = \Platform
_ -> HasDebugCallStack => RealReg -> FreeRegs -> FreeRegs
RealReg -> FreeRegs -> FreeRegs
AArch64.releaseReg
instance FR RV64.FreeRegs where
frAllocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frAllocateReg = (RealReg -> FreeRegs -> FreeRegs)
-> Platform -> RealReg -> FreeRegs -> FreeRegs
forall a b. a -> b -> a
const HasCallStack => RealReg -> FreeRegs -> FreeRegs
RealReg -> FreeRegs -> FreeRegs
RV64.allocateReg
frGetFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg]
frGetFreeRegs = (RegClass -> FreeRegs -> [RealReg])
-> Platform -> RegClass -> FreeRegs -> [RealReg]
forall a b. a -> b -> a
const RegClass -> FreeRegs -> [RealReg]
RV64.getFreeRegs
frInitFreeRegs :: Platform -> FreeRegs
frInitFreeRegs = Platform -> FreeRegs
RV64.initFreeRegs
frReleaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frReleaseReg = (RealReg -> FreeRegs -> FreeRegs)
-> Platform -> RealReg -> FreeRegs -> FreeRegs
forall a b. a -> b -> a
const HasCallStack => RealReg -> FreeRegs -> FreeRegs
RealReg -> FreeRegs -> FreeRegs
RV64.releaseReg
allFreeRegs :: FR freeRegs => Platform -> freeRegs -> [RealReg]
allFreeRegs :: forall freeRegs. FR freeRegs => Platform -> freeRegs -> [RealReg]
allFreeRegs Platform
plat freeRegs
fr = (RegClass -> [RealReg]) -> [RegClass] -> [RealReg]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\RegClass
rcls -> Platform -> RegClass -> freeRegs -> [RealReg]
forall freeRegs.
FR freeRegs =>
Platform -> RegClass -> freeRegs -> [RealReg]
frGetFreeRegs Platform
plat RegClass
rcls freeRegs
fr) [RegClass]
allRegClasses
where
allRegClasses :: [RegClass]
allRegClasses =
case Arch -> RegArch
registerArch (Platform -> Arch
platformArch Platform
plat) of
RegArch
Unified -> [RegClass]
Unified.allRegClasses
RegArch
Separate -> [RegClass]
Separate.allRegClasses
RegArch
NoVectors -> [RegClass]
NoVectors.allRegClasses
maxSpillSlots :: NCGConfig -> Int
maxSpillSlots :: NCGConfig -> Int
maxSpillSlots NCGConfig
config = case Platform -> Arch
platformArch (NCGConfig -> Platform
ncgPlatform NCGConfig
config) of
Arch
ArchX86 -> NCGConfig -> Int
X86.Instr.maxSpillSlots NCGConfig
config
Arch
ArchX86_64 -> NCGConfig -> Int
X86.Instr.maxSpillSlots NCGConfig
config
Arch
ArchPPC -> NCGConfig -> Int
PPC.Instr.maxSpillSlots NCGConfig
config
Arch
ArchS390X -> String -> Int
forall a. HasCallStack => String -> a
panic String
"maxSpillSlots ArchS390X"
ArchARM ArmISA
_ [ArmISAExt]
_ ArmABI
_ -> String -> Int
forall a. HasCallStack => String -> a
panic String
"maxSpillSlots ArchARM"
Arch
ArchAArch64 -> NCGConfig -> Int
AArch64.Instr.maxSpillSlots NCGConfig
config
ArchPPC_64 PPC_64ABI
_ -> NCGConfig -> Int
PPC.Instr.maxSpillSlots NCGConfig
config
Arch
ArchAlpha -> String -> Int
forall a. HasCallStack => String -> a
panic String
"maxSpillSlots ArchAlpha"
Arch
ArchMipseb -> String -> Int
forall a. HasCallStack => String -> a
panic String
"maxSpillSlots ArchMipseb"
Arch
ArchMipsel -> String -> Int
forall a. HasCallStack => String -> a
panic String
"maxSpillSlots ArchMipsel"
Arch
ArchRISCV64 -> NCGConfig -> Int
RV64.Instr.maxSpillSlots NCGConfig
config
Arch
ArchLoongArch64->String -> Int
forall a. HasCallStack => String -> a
panic String
"maxSpillSlots ArchLoongArch64"
Arch
ArchJavaScript-> String -> Int
forall a. HasCallStack => String -> a
panic String
"maxSpillSlots ArchJavaScript"
Arch
ArchWasm32 -> String -> Int
forall a. HasCallStack => String -> a
panic String
"maxSpillSlots ArchWasm32"
Arch
ArchUnknown -> String -> Int
forall a. HasCallStack => String -> a
panic String
"maxSpillSlots ArchUnknown"