Remove CPP from nativeGen/RegAlloc/Graph/TrivColorable.hs
[ghc-hetmet.git] / compiler / nativeGen / RegAlloc / Graph / TrivColorable.hs
index 4c05860..6cc67ad 100644 (file)
@@ -1,7 +1,7 @@
-{-# OPTIONS -fno-warn-unused-binds #-}
+{-# LANGUAGE BangPatterns #-}
 
 module RegAlloc.Graph.TrivColorable (
-       trivColorable,
+        trivColorable,
 )
 
 where
@@ -15,78 +15,51 @@ import GraphBase
 
 import UniqFM
 import FastTypes
+import Platform
+import Panic
 
 
 -- trivColorable ---------------------------------------------------------------
 
 -- trivColorable function for the graph coloring allocator
 --
---     This gets hammered by scanGraph during register allocation,
---     so needs to be fairly efficient.
+--      This gets hammered by scanGraph during register allocation,
+--      so needs to be fairly efficient.
 --
---     NOTE:   This only works for arcitectures with just RcInteger and RcDouble
---             (which are disjoint) ie. x86, x86_64 and ppc
+--      NOTE:   This only works for arcitectures with just RcInteger and RcDouble
+--              (which are disjoint) ie. x86, x86_64 and ppc
 --
---     The number of allocatable regs is hard coded here so we can do a fast
---             comparision in trivColorable. 
+--      The number of allocatable regs is hard coded in here so we can do
+--              a fast comparision in trivColorable.
 --
---     It's ok if these numbers are _less_ than the actual number of free regs, 
---             but they can't be more or the register conflict graph won't color.
+--      It's ok if these numbers are _less_ than the actual number of free
+--              regs, but they can't be more or the register conflict
+--              graph won't color.
 --
---     If the graph doesn't color then the allocator will panic, but it won't 
---             generate bad object code or anything nasty like that.
+--      If the graph doesn't color then the allocator will panic, but it won't
+--              generate bad object code or anything nasty like that.
 --
---     There is an allocatableRegsInClass :: RegClass -> Int, but doing the unboxing
---     is too slow for us here.
+--      There is an allocatableRegsInClass :: RegClass -> Int, but doing
+--      the unboxing is too slow for us here.
+--      TODO: Is that still true? Could we use allocatableRegsInClass
+--      without losing performance now?
 --
---     Look at includes/stg/MachRegs.h to get these numbers.
+--      Look at includes/stg/MachRegs.h to get the numbers.
 --
 
-#if i386_TARGET_ARCH
-#define ALLOCATABLE_REGS_INTEGER (_ILIT(3))
-#define ALLOCATABLE_REGS_DOUBLE  (_ILIT(6))
-#define ALLOCATABLE_REGS_FLOAT   (_ILIT(0))
-#define ALLOCATABLE_REGS_SSE     (_ILIT(8))
-
-
-#elif x86_64_TARGET_ARCH
-#define ALLOCATABLE_REGS_INTEGER (_ILIT(5))
-#define ALLOCATABLE_REGS_DOUBLE  (_ILIT(0))
-#define ALLOCATABLE_REGS_FLOAT   (_ILIT(0))
-#define ALLOCATABLE_REGS_SSE     (_ILIT(10))
-
-#elif powerpc_TARGET_ARCH
-#define ALLOCATABLE_REGS_INTEGER (_ILIT(16))
-#define ALLOCATABLE_REGS_DOUBLE  (_ILIT(26))
-#define ALLOCATABLE_REGS_FLOAT   (_ILIT(0))
-#define ALLOCATABLE_REGS_SSE     (_ILIT(0))
-
-
-#elif sparc_TARGET_ARCH
-#define ALLOCATABLE_REGS_INTEGER (_ILIT(14))
-#define ALLOCATABLE_REGS_DOUBLE  (_ILIT(11))
-#define ALLOCATABLE_REGS_FLOAT   (_ILIT(22))
-#define ALLOCATABLE_REGS_SSE     (_ILIT(0))
-
-
-#else
-#error ToDo: choose which trivColorable function to use for this architecture.
-#endif
-
-
 
 -- Disjoint registers ----------------------------------------------------------
---     
---     The definition has been unfolded into individual cases for speed.
---     Each architecture has a different register setup, so we use a
---     different regSqueeze function for each.
 --
-accSqueeze 
-       :: FastInt 
-       -> FastInt
-       -> (reg -> FastInt) 
-       -> UniqFM reg
-       -> FastInt
+--      The definition has been unfolded into individual cases for speed.
+--      Each architecture has a different register setup, so we use a
+--      different regSqueeze function for each.
+--
+accSqueeze
+        :: FastInt
+        -> FastInt
+        -> (reg -> FastInt)
+        -> UniqFM reg
+        -> FastInt
 
 accSqueeze count maxCount squeeze ufm = acc count (eltsUFM ufm)
   where acc count [] = count
@@ -125,60 +98,96 @@ the most efficient variant tried. Benchmark compiling 10-times SHA1.lhs follows.
                                  100.00%   166.23%   94.18%    100.95%
 -}
 
+-- TODO: We shouldn't be using defaultTargetPlatform here.
+--       We should be passing DynFlags in instead, and looking at
+--       its targetPlatform.
+
 trivColorable
-       :: (RegClass -> VirtualReg -> FastInt)
-       -> (RegClass -> RealReg    -> FastInt)
-       -> Triv VirtualReg RegClass RealReg
+        :: (RegClass -> VirtualReg -> FastInt)
+        -> (RegClass -> RealReg    -> FastInt)
+        -> Triv VirtualReg RegClass RealReg
 
 trivColorable virtualRegSqueeze realRegSqueeze RcInteger conflicts exclusions
-       | count2        <- accSqueeze (_ILIT(0)) ALLOCATABLE_REGS_INTEGER 
-                               (virtualRegSqueeze RcInteger)
-                               conflicts
-                               
-       , count3        <- accSqueeze  count2    ALLOCATABLE_REGS_INTEGER
-                               (realRegSqueeze   RcInteger)
-                               exclusions
-
-       = count3 <# ALLOCATABLE_REGS_INTEGER
+        | let !cALLOCATABLE_REGS_INTEGER
+                  = iUnbox $ case platformArch defaultTargetPlatform of
+                             ArchX86     -> 3
+                             ArchX86_64  -> 5
+                             ArchPPC     -> 16
+                             ArchSPARC   -> 14
+                             ArchPPC_64  -> panic "trivColorable ArchPPC_64"
+                             ArchUnknown -> panic "trivColorable ArchUnknown"
+        , count2        <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_INTEGER
+                                (virtualRegSqueeze RcInteger)
+                                conflicts
+
+        , count3        <- accSqueeze  count2    cALLOCATABLE_REGS_INTEGER
+                                (realRegSqueeze   RcInteger)
+                                exclusions
+
+        = count3 <# cALLOCATABLE_REGS_INTEGER
 
 trivColorable virtualRegSqueeze realRegSqueeze RcFloat conflicts exclusions
-       | count2        <- accSqueeze (_ILIT(0)) ALLOCATABLE_REGS_FLOAT
-                               (virtualRegSqueeze RcFloat)
-                               conflicts
-                               
-       , count3        <- accSqueeze  count2    ALLOCATABLE_REGS_FLOAT
-                               (realRegSqueeze   RcFloat)
-                               exclusions
-
-       = count3 <# ALLOCATABLE_REGS_FLOAT
+        | let !cALLOCATABLE_REGS_FLOAT
+                  = iUnbox $ case platformArch defaultTargetPlatform of
+                             ArchX86     -> 0
+                             ArchX86_64  -> 0
+                             ArchPPC     -> 0
+                             ArchSPARC   -> 22
+                             ArchPPC_64  -> panic "trivColorable ArchPPC_64"
+                             ArchUnknown -> panic "trivColorable ArchUnknown"
+        , count2        <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_FLOAT
+                                (virtualRegSqueeze RcFloat)
+                                conflicts
+
+        , count3        <- accSqueeze  count2    cALLOCATABLE_REGS_FLOAT
+                                (realRegSqueeze   RcFloat)
+                                exclusions
+
+        = count3 <# cALLOCATABLE_REGS_FLOAT
 
 trivColorable virtualRegSqueeze realRegSqueeze RcDouble conflicts exclusions
-       | count2        <- accSqueeze (_ILIT(0)) ALLOCATABLE_REGS_DOUBLE
-                               (virtualRegSqueeze RcDouble)
-                               conflicts
-                               
-       , count3        <- accSqueeze  count2    ALLOCATABLE_REGS_DOUBLE
-                               (realRegSqueeze   RcDouble)
-                               exclusions
-
-       = count3 <# ALLOCATABLE_REGS_DOUBLE
+        | let !cALLOCATABLE_REGS_DOUBLE
+                  = iUnbox $ case platformArch defaultTargetPlatform of
+                             ArchX86     -> 6
+                             ArchX86_64  -> 0
+                             ArchPPC     -> 26
+                             ArchSPARC   -> 11
+                             ArchPPC_64  -> panic "trivColorable ArchPPC_64"
+                             ArchUnknown -> panic "trivColorable ArchUnknown"
+        , count2        <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_DOUBLE
+                                (virtualRegSqueeze RcDouble)
+                                conflicts
+
+        , count3        <- accSqueeze  count2    cALLOCATABLE_REGS_DOUBLE
+                                (realRegSqueeze   RcDouble)
+                                exclusions
+
+        = count3 <# cALLOCATABLE_REGS_DOUBLE
 
 trivColorable virtualRegSqueeze realRegSqueeze RcDoubleSSE conflicts exclusions
-       | count2        <- accSqueeze (_ILIT(0)) ALLOCATABLE_REGS_SSE
-                               (virtualRegSqueeze RcDoubleSSE)
-                               conflicts
-                               
-       , count3        <- accSqueeze  count2    ALLOCATABLE_REGS_SSE
-                               (realRegSqueeze   RcDoubleSSE)
-                               exclusions
+        | let !cALLOCATABLE_REGS_SSE
+                  = iUnbox $ case platformArch defaultTargetPlatform of
+                             ArchX86     -> 8
+                             ArchX86_64  -> 10
+                             ArchPPC     -> 0
+                             ArchSPARC   -> 0
+                             ArchPPC_64  -> panic "trivColorable ArchPPC_64"
+                             ArchUnknown -> panic "trivColorable ArchUnknown"
+        , count2        <- accSqueeze (_ILIT(0)) cALLOCATABLE_REGS_SSE
+                                (virtualRegSqueeze RcDoubleSSE)
+                                conflicts
 
-       = count3 <# ALLOCATABLE_REGS_SSE
+        , count3        <- accSqueeze  count2    cALLOCATABLE_REGS_SSE
+                                (realRegSqueeze   RcDoubleSSE)
+                                exclusions
+
+        = count3 <# cALLOCATABLE_REGS_SSE
 
 
 -- Specification Code ----------------------------------------------------------
 --
---     The trivColorable function for each particular architecture should
---     implement the following function, but faster.
+--      The trivColorable function for each particular architecture should
+--      implement the following function, but faster.
 --
 
 {-
@@ -186,39 +195,39 @@ trivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool
 trivColorable classN conflicts exclusions
  = let
 
-       acc :: Reg -> (Int, Int) -> (Int, Int)
-       acc r (cd, cf)  
-        = case regClass r of
-               RcInteger       -> (cd+1, cf)
-               RcFloat         -> (cd,   cf+1)
-               _               -> panic "Regs.trivColorable: reg class not handled"
+        acc :: Reg -> (Int, Int) -> (Int, Int)
+        acc r (cd, cf)
+         = case regClass r of
+                RcInteger       -> (cd+1, cf)
+                RcFloat         -> (cd,   cf+1)
+                _               -> panic "Regs.trivColorable: reg class not handled"
 
-       tmp                     = foldUniqSet acc (0, 0) conflicts
-       (countInt,  countFloat) = foldUniqSet acc tmp    exclusions
+        tmp                     = foldUniqSet acc (0, 0) conflicts
+        (countInt,  countFloat) = foldUniqSet acc tmp    exclusions
 
-       squeese         = worst countInt   classN RcInteger
-                       + worst countFloat classN RcFloat
+        squeese         = worst countInt   classN RcInteger
+                        + worst countFloat classN RcFloat
 
-   in  squeese < allocatableRegsInClass classN
+   in   squeese < allocatableRegsInClass classN
 
 -- | Worst case displacement
---     node N of classN has n neighbors of class C.
+--      node N of classN has n neighbors of class C.
 --
---     We currently only have RcInteger and RcDouble, which don't conflict at all.
---     This is a bit boring compared to what's in RegArchX86.
+--      We currently only have RcInteger and RcDouble, which don't conflict at all.
+--      This is a bit boring compared to what's in RegArchX86.
 --
 worst :: Int -> RegClass -> RegClass -> Int
 worst n classN classC
  = case classN of
-       RcInteger
-        -> case classC of
-               RcInteger       -> min n (allocatableRegsInClass RcInteger)
-               RcFloat         -> 0
-               
-       RcDouble
-        -> case classC of
-               RcFloat         -> min n (allocatableRegsInClass RcFloat)
-               RcInteger       -> 0
+        RcInteger
+         -> case classC of
+                RcInteger       -> min n (allocatableRegsInClass RcInteger)
+                RcFloat         -> 0
+
+        RcDouble
+         -> case classC of
+                RcFloat         -> min n (allocatableRegsInClass RcFloat)
+                RcInteger       -> 0
 
 -- allocatableRegs is allMachRegNos with the fixed-use regs removed.
 -- i.e., these are the regs for which we are prepared to allow the
@@ -230,21 +239,21 @@ allocatableRegs
 
 
 -- | The number of regs in each class.
---     We go via top level CAFs to ensure that we're not recomputing
---     the length of these lists each time the fn is called.
+--      We go via top level CAFs to ensure that we're not recomputing
+--      the length of these lists each time the fn is called.
 allocatableRegsInClass :: RegClass -> Int
 allocatableRegsInClass cls
  = case cls of
-       RcInteger       -> allocatableRegsInteger
-       RcFloat         -> allocatableRegsDouble
+        RcInteger       -> allocatableRegsInteger
+        RcFloat         -> allocatableRegsDouble
 
 allocatableRegsInteger :: Int
-allocatableRegsInteger 
-       = length $ filter (\r -> regClass r == RcInteger) 
-                $ map RealReg allocatableRegs
+allocatableRegsInteger
+        = length $ filter (\r -> regClass r == RcInteger)
+                 $ map RealReg allocatableRegs
 
 allocatableRegsFloat :: Int
 allocatableRegsFloat
-       = length $ filter (\r -> regClass r == RcFloat 
-                $ map RealReg allocatableRegs
+        = length $ filter (\r -> regClass r == RcFloat
+                 $ map RealReg allocatableRegs
 -}