Remove some CPP
authorIan Lynagh <ian@well-typed.com>
Mon, 10 Sep 2012 11:45:34 +0000 (12:45 +0100)
committerIan Lynagh <ian@well-typed.com>
Mon, 10 Sep 2012 11:45:34 +0000 (12:45 +0100)
compiler/ghc.cabal.in
compiler/nativeGen/RegAlloc/Linear/FreeRegs.hs
compiler/nativeGen/RegAlloc/Linear/Main.hs
compiler/nativeGen/RegAlloc/Linear/X86/FreeRegs.hs
compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs [new file with mode: 0644]

index 8cec827..f07cccf 100644 (file)
@@ -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
 
index 887af17..4a5af75 100644 (file)
@@ -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
index c2f89de..bf0f5aa 100644 (file)
@@ -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"
index 6309b24..0fcd658 100644 (file)
@@ -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_64/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/X86_64/FreeRegs.hs
new file mode 100644 (file)
index 0000000..c04fce9
--- /dev/null
@@ -0,0 +1,52 @@
+
+-- | 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"
+
+