Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/c85539630eef593061ac223c18d248355f78a921 >--------------------------------------------------------------- commit c85539630eef593061ac223c18d248355f78a921 Author: Ian Lynagh <[email protected]> Date: Mon Sep 10 12:45:34 2012 +0100 Remove some CPP >--------------------------------------------------------------- compiler/ghc.cabal.in | 1 + compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs | 13 ++++++-- compiler/nativeGen/RegAlloc/Linear/Main.hs | 15 +++++---- compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs | 27 +++++++---------- .../RegAlloc/Linear/{X86 => X86_64}/FreeRegs.hs | 30 ++++++++----------- 5 files changed, 43 insertions(+), 43 deletions(-) diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 8cec827..f07cccf 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -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 diff --git a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs index 887af17..4a5af75 100644 --- a/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs +++ b/compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs @@ -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 diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs index c2f89de..bf0f5aa 100644 --- a/compiler/nativeGen/RegAlloc/Linear/Main.hs +++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs @@ -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" diff --git a/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs index 6309b24..0fcd658 100644 --- a/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs +++ b/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs @@ -1,5 +1,5 @@ --- | 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" - diff --git a/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs similarity index 61% copy from compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs copy to compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs index 6309b24..c04fce9 100644 --- a/compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs +++ b/compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs @@ -1,6 +1,6 @@ --- | Free regs map for i386 and x86_64 -module RegAlloc.Linear.X86.FreeRegs +-- | Free regs map for x86_64 +module RegAlloc.Linear.X86_64.FreeRegs where import X86.Regs @@ -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 Word64 + 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_64.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,10 @@ 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" + = panic "RegAlloc.Linear.X86_64.FreeRegs.allocateReg: no reg" _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
