-- | 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 GHC.CmmToAsm.Reg.Graph.X86 (
        classOfReg,
        regsOfClass,
        regName,
        regAlias,
        worst,
        squeese,
) where

import GHC.Prelude

import GHC.CmmToAsm.Reg.Graph.Base  (Reg(..), RegSub(..), RegClass(..))
import GHC.Types.Unique.Set

import qualified Data.Array as A


-- | Determine the class of a register
classOfReg :: Reg -> RegClass
classOfReg :: Reg -> RegClass
classOfReg Reg
reg
 = case Reg
reg of
        Reg RegClass
c Int
_         -> RegClass
c

        RegSub RegSub
SubL16 Reg
_ -> RegClass
ClassG16
        RegSub RegSub
SubL8  Reg
_ -> RegClass
ClassG8
        RegSub RegSub
SubL8H Reg
_ -> RegClass
ClassG8


-- | Determine all the regs that make up a certain class.
regsOfClass :: RegClass -> UniqSet Reg
regsOfClass :: RegClass -> UniqSet Reg
regsOfClass RegClass
c
 = case RegClass
c of
        RegClass
ClassG32
         -> [Reg] -> UniqSet Reg
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet   [ RegClass -> Int -> Reg
Reg RegClass
ClassG32  Int
i
                        | Int
i <- [Int
0..Int
7] ]

        RegClass
ClassG16
         -> [Reg] -> UniqSet Reg
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet   [ RegSub -> Reg -> Reg
RegSub RegSub
SubL16 (RegClass -> Int -> Reg
Reg RegClass
ClassG32 Int
i)
                        | Int
i <- [Int
0..Int
7] ]

        RegClass
ClassG8
         -> UniqSet Reg -> UniqSet Reg -> UniqSet Reg
forall a. UniqSet a -> UniqSet a -> UniqSet a
unionUniqSets
                ([Reg] -> UniqSet Reg
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet [ RegSub -> Reg -> Reg
RegSub RegSub
SubL8  (RegClass -> Int -> Reg
Reg RegClass
ClassG32 Int
i) | Int
i <- [Int
0..Int
3] ])
                ([Reg] -> UniqSet Reg
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet [ RegSub -> Reg -> Reg
RegSub RegSub
SubL8H (RegClass -> Int -> Reg
Reg RegClass
ClassG32 Int
i) | Int
i <- [Int
0..Int
3] ])

        RegClass
ClassF64
         -> [Reg] -> UniqSet Reg
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet   [ RegClass -> Int -> Reg
Reg RegClass
ClassF64  Int
i
                        | Int
i <- [Int
0..Int
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 -> Maybe String
regName Reg
reg
 = case Reg
reg of
        Reg RegClass
ClassG32 Int
i
         | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7 ->
           let names :: Array Int String
names = (Int, Int) -> [String] -> Array Int String
forall i e. Ix i => (i, i) -> [e] -> Array i e
A.listArray (Int
0,Int
8)
                       [ String
"eax", String
"ebx", String
"ecx", String
"edx"
                       , String
"ebp", String
"esi", String
"edi", String
"esp" ]
           in String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Array Int String
names Array Int String -> Int -> String
forall i e. Ix i => Array i e -> i -> e
A.! Int
i

        RegSub RegSub
SubL16 (Reg RegClass
ClassG32 Int
i)
         | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7 ->
           let names :: Array Int String
names = (Int, Int) -> [String] -> Array Int String
forall i e. Ix i => (i, i) -> [e] -> Array i e
A.listArray (Int
0,Int
8)
                       [ String
"ax", String
"bx", String
"cx", String
"dx"
                       , String
"bp", String
"si", String
"di", String
"sp"]
           in String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Array Int String
names Array Int String -> Int -> String
forall i e. Ix i => Array i e -> i -> e
A.! Int
i

        RegSub RegSub
SubL8  (Reg RegClass
ClassG32 Int
i)
         | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3 ->
           let names :: Array Int String
names = (Int, Int) -> [String] -> Array Int String
forall i e. Ix i => (i, i) -> [e] -> Array i e
A.listArray (Int
0,Int
4) [ String
"al", String
"bl", String
"cl", String
"dl"]
           in String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Array Int String
names Array Int String -> Int -> String
forall i e. Ix i => Array i e -> i -> e
A.! Int
i

        RegSub RegSub
SubL8H (Reg RegClass
ClassG32 Int
i)
         | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3 ->
           let names :: Array Int String
names = (Int, Int) -> [String] -> Array Int String
forall i e. Ix i => (i, i) -> [e] -> Array i e
A.listArray (Int
0,Int
4) [ String
"ah", String
"bh", String
"ch", String
"dh"]
           in String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Array Int String
names Array Int String -> Int -> String
forall i e. Ix i => Array i e -> i -> e
A.! Int
i

        Reg
_         -> Maybe String
forall a. Maybe a
Nothing


-- | Which regs alias what other regs.
regAlias :: Reg -> UniqSet Reg
regAlias :: Reg -> UniqSet Reg
regAlias Reg
reg
 = case Reg
reg of

        -- 32 bit regs alias all of the subregs
        Reg RegClass
ClassG32 Int
i

         -- for eax, ebx, ecx, eds
         |  Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3
         -> [Reg] -> UniqSet Reg
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet
         ([Reg] -> UniqSet Reg) -> [Reg] -> UniqSet Reg
forall a b. (a -> b) -> a -> b
$ [ RegClass -> Int -> Reg
Reg RegClass
ClassG32 Int
i,   RegSub -> Reg -> Reg
RegSub RegSub
SubL16 Reg
reg
           , RegSub -> Reg -> Reg
RegSub RegSub
SubL8 Reg
reg, RegSub -> Reg -> Reg
RegSub RegSub
SubL8H Reg
reg ]

         -- for esi, edi, esp, ebp
         | Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7
         -> [Reg] -> UniqSet Reg
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet
         ([Reg] -> UniqSet Reg) -> [Reg] -> UniqSet Reg
forall a b. (a -> b) -> a -> b
$ [ RegClass -> Int -> Reg
Reg RegClass
ClassG32 Int
i,   RegSub -> Reg -> Reg
RegSub RegSub
SubL16 Reg
reg ]

        -- 16 bit subregs alias the whole reg
        RegSub RegSub
SubL16 r :: Reg
r@(Reg RegClass
ClassG32 Int
_)
         ->     Reg -> UniqSet Reg
regAlias Reg
r

        -- 8 bit subregs alias the 32 and 16, but not the other 8 bit subreg
        RegSub RegSub
SubL8  r :: Reg
r@(Reg RegClass
ClassG32 Int
_)
         -> [Reg] -> UniqSet Reg
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet ([Reg] -> UniqSet Reg) -> [Reg] -> UniqSet Reg
forall a b. (a -> b) -> a -> b
$ [ Reg
r, RegSub -> Reg -> Reg
RegSub RegSub
SubL16 Reg
r, RegSub -> Reg -> Reg
RegSub RegSub
SubL8 Reg
r ]

        RegSub RegSub
SubL8H r :: Reg
r@(Reg RegClass
ClassG32 Int
_)
         -> [Reg] -> UniqSet Reg
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet ([Reg] -> UniqSet Reg) -> [Reg] -> UniqSet Reg
forall a b. (a -> b) -> a -> b
$ [ Reg
r, RegSub -> Reg -> Reg
RegSub RegSub
SubL16 Reg
r, RegSub -> Reg -> Reg
RegSub RegSub
SubL8H Reg
r ]

        -- fp
        Reg RegClass
ClassF64 Int
_
         -> Reg -> UniqSet Reg
forall a. Uniquable a => a -> UniqSet a
unitUniqSet Reg
reg

        Reg
_ -> String -> UniqSet Reg
forall a. HasCallStack => String -> a
error String
"regAlias: invalid register"


-- | Optimised versions of RegColorBase.{worst, squeese} specific to x86
worst :: Int -> RegClass -> RegClass -> Int
worst :: Int -> RegClass -> RegClass -> Int
worst Int
n RegClass
classN RegClass
classC
 = case RegClass
classN of
        RegClass
ClassG32
         -> case RegClass
classC of
                RegClass
ClassG32        -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
8
                RegClass
ClassG16        -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
8
                RegClass
ClassG8         -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
4
                RegClass
ClassF64        -> Int
0

        RegClass
ClassG16
         -> case RegClass
classC of
                RegClass
ClassG32        -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
8
                RegClass
ClassG16        -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
8
                RegClass
ClassG8         -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
4
                RegClass
ClassF64        -> Int
0

        RegClass
ClassG8
         -> case RegClass
classC of
                RegClass
ClassG32        -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) Int
8
                RegClass
ClassG16        -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) Int
8
                RegClass
ClassG8         -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
8
                RegClass
ClassF64        -> Int
0

        RegClass
ClassF64
         -> case RegClass
classC of
                RegClass
ClassF64        -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
6
                RegClass
_               -> Int
0

squeese :: RegClass -> [(Int, RegClass)] -> Int
squeese :: RegClass -> [(Int, RegClass)] -> Int
squeese RegClass
classN [(Int, RegClass)]
countCs
        = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((Int, RegClass) -> Int) -> [(Int, RegClass)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
i, RegClass
classC) -> Int -> RegClass -> RegClass -> Int
worst Int
i RegClass
classN RegClass
classC) [(Int, RegClass)]
countCs)