{-# LANGUAGE CPP #-}
module GHC.CmmToAsm.Reg.Linear.FreeRegs (
FR(..),
maxSpillSlots
)
#include "HsVersions.h"
where
import GHC.Prelude
import GHC.Platform.Reg
import GHC.Platform.Reg.Class
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.SPARC as SPARC
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.PPC.Instr as PPC.Instr
import qualified GHC.CmmToAsm.SPARC.Instr as SPARC.Instr
import qualified GHC.CmmToAsm.X86.Instr as X86.Instr
import qualified GHC.CmmToAsm.AArch64.Instr as AArch64.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
_ -> HasCallStack => 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
_ -> HasCallStack => RealReg -> FreeRegs -> FreeRegs
AArch64.releaseReg
instance FR SPARC.FreeRegs where
frAllocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frAllocateReg = Platform -> RealReg -> FreeRegs -> FreeRegs
SPARC.allocateReg
frGetFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg]
frGetFreeRegs = \Platform
_ -> RegClass -> FreeRegs -> [RealReg]
SPARC.getFreeRegs
frInitFreeRegs :: Platform -> FreeRegs
frInitFreeRegs = Platform -> FreeRegs
SPARC.initFreeRegs
frReleaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
frReleaseReg = Platform -> RealReg -> FreeRegs -> FreeRegs
SPARC.releaseReg
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 -> forall a. String -> a
panic String
"maxSpillSlots ArchS390X"
Arch
ArchSPARC -> NCGConfig -> Int
SPARC.Instr.maxSpillSlots NCGConfig
config
Arch
ArchSPARC64 -> forall a. String -> a
panic String
"maxSpillSlots ArchSPARC64"
ArchARM ArmISA
_ [ArmISAExt]
_ ArmABI
_ -> forall a. 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 -> forall a. String -> a
panic String
"maxSpillSlots ArchAlpha"
Arch
ArchMipseb -> forall a. String -> a
panic String
"maxSpillSlots ArchMipseb"
Arch
ArchMipsel -> forall a. String -> a
panic String
"maxSpillSlots ArchMipsel"
Arch
ArchRISCV64 -> forall a. String -> a
panic String
"maxSpillSlots ArchRISCV64"
Arch
ArchJavaScript-> forall a. String -> a
panic String
"maxSpillSlots ArchJavaScript"
Arch
ArchUnknown -> forall a. String -> a
panic String
"maxSpillSlots ArchUnknown"