Commit c8553963 authored by ian@well-typed.com's avatar ian@well-typed.com

Remove some CPP

parent 0ee44def
......@@ -542,6 +542,7 @@ Library
RegAlloc.Linear.StackMap
RegAlloc.Linear.Base
RegAlloc.Linear.X86.FreeRegs
RegAlloc.Linear.X86_64.FreeRegs
RegAlloc.Linear.PPC.FreeRegs
RegAlloc.Linear.SPARC.FreeRegs
......
......@@ -33,9 +33,10 @@ import Platform
-- getFreeRegs cls f = filter ( (==cls) . regClass . RealReg ) f
-- allocateReg f r = filter (/= r) f
import qualified RegAlloc.Linear.PPC.FreeRegs as PPC
import qualified RegAlloc.Linear.SPARC.FreeRegs as SPARC
import qualified RegAlloc.Linear.X86.FreeRegs as X86
import qualified RegAlloc.Linear.PPC.FreeRegs as PPC
import qualified RegAlloc.Linear.SPARC.FreeRegs as SPARC
import qualified RegAlloc.Linear.X86.FreeRegs as X86
import qualified RegAlloc.Linear.X86_64.FreeRegs as X86_64
import qualified PPC.Instr
import qualified SPARC.Instr
......@@ -53,6 +54,12 @@ instance FR X86.FreeRegs where
frInitFreeRegs = X86.initFreeRegs
frReleaseReg = \_ -> X86.releaseReg
instance FR X86_64.FreeRegs where
frAllocateReg = \_ -> X86_64.allocateReg
frGetFreeRegs = X86_64.getFreeRegs
frInitFreeRegs = X86_64.initFreeRegs
frReleaseReg = \_ -> X86_64.releaseReg
instance FR PPC.FreeRegs where
frAllocateReg = \_ -> PPC.allocateReg
frGetFreeRegs = \_ -> PPC.getFreeRegs
......
......@@ -106,9 +106,10 @@ import RegAlloc.Linear.StackMap
import RegAlloc.Linear.FreeRegs
import RegAlloc.Linear.Stats
import RegAlloc.Linear.JoinToTargets
import qualified RegAlloc.Linear.PPC.FreeRegs as PPC
import qualified RegAlloc.Linear.SPARC.FreeRegs as SPARC
import qualified RegAlloc.Linear.X86.FreeRegs as X86
import qualified RegAlloc.Linear.PPC.FreeRegs as PPC
import qualified RegAlloc.Linear.SPARC.FreeRegs as SPARC
import qualified RegAlloc.Linear.X86.FreeRegs as X86
import qualified RegAlloc.Linear.X86_64.FreeRegs as X86_64
import TargetReg
import RegAlloc.Liveness
import Instruction
......@@ -188,10 +189,10 @@ linearRegAlloc
linearRegAlloc dflags first_id block_live sccs
= let platform = targetPlatform dflags
in case platformArch platform of
ArchX86 -> linearRegAlloc' platform (frInitFreeRegs platform :: X86.FreeRegs) first_id block_live sccs
ArchX86_64 -> linearRegAlloc' platform (frInitFreeRegs platform :: X86.FreeRegs) first_id block_live sccs
ArchSPARC -> linearRegAlloc' platform (frInitFreeRegs platform :: SPARC.FreeRegs) first_id block_live sccs
ArchPPC -> linearRegAlloc' platform (frInitFreeRegs platform :: PPC.FreeRegs) first_id block_live sccs
ArchX86 -> linearRegAlloc' platform (frInitFreeRegs platform :: X86.FreeRegs) first_id block_live sccs
ArchX86_64 -> linearRegAlloc' platform (frInitFreeRegs platform :: X86_64.FreeRegs) first_id block_live sccs
ArchSPARC -> linearRegAlloc' platform (frInitFreeRegs platform :: SPARC.FreeRegs) first_id block_live sccs
ArchPPC -> linearRegAlloc' platform (frInitFreeRegs platform :: PPC.FreeRegs) first_id block_live sccs
ArchARM _ _ _ -> panic "linearRegAlloc ArchARM"
ArchPPC_64 -> panic "linearRegAlloc ArchPPC_64"
ArchUnknown -> panic "linearRegAlloc ArchUnknown"
......
-- | Free regs map for i386 and x86_64
-- | Free regs map for i386
module RegAlloc.Linear.X86.FreeRegs
where
......@@ -12,29 +12,25 @@ import Platform
import Data.Word
import Data.Bits
type FreeRegs
#ifdef i386_TARGET_ARCH
= Word32
#else
= Word64
#endif
newtype FreeRegs = FreeRegs Word32
deriving Show
noFreeRegs :: FreeRegs
noFreeRegs = 0
noFreeRegs = FreeRegs 0
releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg (RealRegSingle n) f
= f .|. (1 `shiftL` n)
releaseReg (RealRegSingle n) (FreeRegs f)
= FreeRegs (f .|. (1 `shiftL` n))
releaseReg _ _
= panic "RegAlloc.Linear.X86.FreeRegs.realeaseReg: no reg"
= panic "RegAlloc.Linear.X86.FreeRegs.releaseReg: no reg"
initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
= foldr releaseReg noFreeRegs (allocatableRegs platform)
getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazilly
getFreeRegs platform cls f = go f 0
getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
getFreeRegs platform cls (FreeRegs f) = go f 0
where go 0 _ = []
go n m
......@@ -47,10 +43,9 @@ getFreeRegs platform cls f = go f 0
-- in order to find a floating-point one.
allocateReg :: RealReg -> FreeRegs -> FreeRegs
allocateReg (RealRegSingle r) f
= f .&. complement (1 `shiftL` r)
allocateReg (RealRegSingle r) (FreeRegs f)
= FreeRegs (f .&. complement (1 `shiftL` r))
allocateReg _ _
= panic "RegAlloc.Linear.X86.FreeRegs.allocateReg: no reg"
-- | Free regs map for x86_64
module RegAlloc.Linear.X86_64.FreeRegs
where
import X86.Regs
import RegClass
import Reg
import Panic
import Platform
import Data.Word
import Data.Bits
newtype FreeRegs = FreeRegs Word64
deriving Show
noFreeRegs :: FreeRegs
noFreeRegs = FreeRegs 0
releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg (RealRegSingle n) (FreeRegs f)
= FreeRegs (f .|. (1 `shiftL` n))
releaseReg _ _
= panic "RegAlloc.Linear.X86_64.FreeRegs.releaseReg: no reg"
initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
= foldr releaseReg noFreeRegs (allocatableRegs platform)
getFreeRegs :: Platform -> RegClass -> FreeRegs -> [RealReg] -- lazily
getFreeRegs platform cls (FreeRegs f) = go f 0
where go 0 _ = []
go n m
| n .&. 1 /= 0 && classOfRealReg platform (RealRegSingle m) == cls
= RealRegSingle m : (go (n `shiftR` 1) $! (m+1))
| otherwise
= go (n `shiftR` 1) $! (m+1)
-- ToDo: there's no point looking through all the integer registers
-- in order to find a floating-point one.
allocateReg :: RealReg -> FreeRegs -> FreeRegs
allocateReg (RealRegSingle r) (FreeRegs f)
= FreeRegs (f .&. complement (1 `shiftL` r))
allocateReg _ _
= panic "RegAlloc.Linear.X86_64.FreeRegs.allocateReg: no reg"
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment