Add graph coloring register allocator.

[ghc-hetmet.git] / compiler / nativeGen / RegArchX86.hs

diff --git a/compiler/nativeGen/RegArchX86.hs b/compiler/nativeGen/RegArchX86.hs
new file mode 100644 (file)
index 0000000..53f9929
--- /dev/null
+++ b/compiler/nativeGen/RegArchX86.hs
@@ -0,0 +1,147 @@
+
+-- | A description of the register set of the X86.
+--     This isn't used directly in GHC proper.
+--
+--     See RegArchBase.hs for the reference.
+--     See MachRegs.hs for the actual trivColorable function used in GHC.
+--
+module RegArchX86 (
+       classOfReg,
+       regsOfClass,
+       regName,
+       regAlias,
+       worst,
+       squeese,
+) where
+
+import RegArchBase             (Reg(..), RegSub(..), RegClass(..))
+
+import qualified Data.Set      as Set
+import Data.Set                        (Set)
+
+-- | Determine the class of a register
+classOfReg :: Reg -> RegClass
+classOfReg reg
+ = case reg of
+       Reg c i         -> c
+       
+       RegSub SubL16 r -> ClassG16
+       RegSub SubL8  r -> ClassG8
+       RegSub SubL8H r -> ClassG8
+
+       
+-- | Determine all the regs that make up a certain class.
+--
+regsOfClass :: RegClass -> Set Reg
+regsOfClass c
+ = case c of
+       ClassG32        
+        -> Set.fromList [ Reg ClassG32  i                      | i <- [0..7] ]
+
+       ClassG16        
+        -> Set.fromList [ RegSub SubL16 (Reg ClassG32 i)       | i <- [0..7] ]
+
+       ClassG8 
+        -> Set.union
+               (Set.fromList [ RegSub SubL8  (Reg ClassG32 i)  | i <- [0..3] ])
+               (Set.fromList [ RegSub SubL8H (Reg ClassG32 i)  | i <- [0..3] ])
+                       
+       ClassF64        
+        -> Set.fromList [ Reg ClassF64  i                      | i <- [0..5] ]
+       
+
+-- | Determine the common name of a reg
+--     returns Nothing if this reg is not part of the machine.
+       
+regName :: Reg -> Maybe String
+regName reg
+ = case reg of
+       Reg ClassG32 i  
+        | i <= 7       -> Just ([ "eax", "ebx", "ecx", "edx", "ebp", "esi", "edi", "esp" ] !! i)
+
+       RegSub SubL16 (Reg ClassG32 i)
+        | i <= 7       -> Just ([ "ax", "bx", "cx", "dx", "bp", "si", "di", "sp"] !! i)
+        
+       RegSub SubL8  (Reg ClassG32 i)
+        | i <= 3       -> Just ([ "al", "bl", "cl", "dl"] !! i)
+        
+       RegSub SubL8H (Reg ClassG32 i)
+        | i <= 3       -> Just ([ "ah", "bh", "ch", "dh"] !! i)
+
+       _               -> Nothing
+
+       
+-- | Which regs alias what other regs
+regAlias :: Reg -> Set Reg
+regAlias reg
+ = case reg of
+
+       -- 32 bit regs alias all of the subregs
+       Reg ClassG32 i
+        
+        -- for eax, ebx, ecx, eds
+        |  i <= 3              
+        -> Set.fromList $ [ Reg ClassG32 i, RegSub SubL16 reg, RegSub SubL8 reg, RegSub SubL8H reg ]
+        
+        -- for esi, edi, esp, ebp
+        | 4 <= i && i <= 7     
+        -> Set.fromList $ [ Reg ClassG32 i, RegSub SubL16 reg ]
+       
+       
+       -- 16 bit subregs alias the whole reg
+       RegSub SubL16 r@(Reg ClassG32 i)        
+        ->     regAlias r
+       
+       -- 8 bit subregs alias the 32 and 16, but not the other 8 bit subreg
+       RegSub SubL8  r@(Reg ClassG32 i)
+        -> Set.fromList $ [ r, RegSub SubL16 r, RegSub SubL8 r ]
+
+       RegSub SubL8H r@(Reg ClassG32 i)
+        -> Set.fromList $ [ r, RegSub SubL16 r, RegSub SubL8H r ]
+       
+       -- fp
+       Reg ClassF64 i  
+        -> Set.singleton reg
+
+       _ -> error "regAlias: invalid register"
+
+
+-- | Optimised versions of RegColorBase.{worst, squeese} specific to x86
+
+worst :: Int -> RegClass -> RegClass -> Int
+worst n classN classC
+ = case classN of
+       ClassG32
+        -> case classC of
+               ClassG32        -> min n 8
+               ClassG16        -> min n 8
+               ClassG8         -> min n 4
+               ClassF64        -> 0
+               
+       ClassG16
+        -> case classC of
+               ClassG32        -> min n 8
+               ClassG16        -> min n 8
+               ClassG8         -> min n 4
+               ClassF64        -> 0
+               
+       ClassG8
+        -> case classC of
+               ClassG32        -> min (n*2) 8
+               ClassG16        -> min (n*2) 8
+               ClassG8         -> min n 8
+               ClassF64        -> 0
+               
+       ClassF64
+        -> case classC of
+               ClassF64        -> min n 6
+               _               -> 0
+               
+squeese :: RegClass -> [(Int, RegClass)] -> Int
+squeese classN countCs
+       = sum (map (\(i, classC) -> worst i classN classC) countCs)
+       
+
+
+
+