-- | 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 RegAlloc.Graph.ArchX86 (
        classOfReg,
        regsOfClass,
        regName,
        regAlias,
        worst,
        squeese,
) where

import GhcPrelude

import RegAlloc.Graph.ArchBase  (Reg(..), RegSub(..), RegClass(..))
import UniqSet

import qualified Data.Array as A


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

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


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

        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 <- [0..7] ]

        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 <- [0..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 <- [0..3] ])

        ClassF64
         -> [Reg] -> UniqSet Reg
forall a. Uniquable a => [a] -> UniqSet a
mkUniqSet   [ RegClass -> Int -> Reg
Reg RegClass
ClassF64  Int
i
                        | Int
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 -> Maybe String
regName reg :: Reg
reg
 = case Reg
reg of
        Reg ClassG32 i :: Int
i
         | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 (0,8)
                       [ "eax", "ebx", "ecx", "edx"
                       , "ebp", "esi", "edi", "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 SubL16 (Reg ClassG32 i :: Int
i)
         | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 (0,8)
                       [ "ax", "bx", "cx", "dx"
                       , "bp", "si", "di", "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 SubL8  (Reg ClassG32 i :: Int
i)
         | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 (0,4) [ "al", "bl", "cl", "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 SubL8H (Reg ClassG32 i :: Int
i)
         | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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 (0,4) [ "ah", "bh", "ch", "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

        _         -> Maybe String
forall a. Maybe a
Nothing


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

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

         -- for eax, ebx, ecx, eds
         |  Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 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
         | 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
<= 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 SubL16 r :: Reg
r@(Reg ClassG32 _)
         ->     Reg -> UniqSet Reg
regAlias Reg
r

        -- 8 bit subregs alias the 32 and 16, but not the other 8 bit subreg
        RegSub SubL8  r :: Reg
r@(Reg ClassG32 _)
         -> [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 SubL8H r :: Reg
r@(Reg ClassG32 _)
         -> [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 ClassF64 _
         -> Reg -> UniqSet Reg
forall a. Uniquable a => a -> UniqSet a
unitUniqSet Reg
reg

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


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

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

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

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

squeese :: RegClass -> [(Int, RegClass)] -> Int
squeese :: RegClass -> [(Int, RegClass)] -> Int
squeese classN :: RegClass
classN countCs :: [(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 (\(i :: Int
i, classC :: RegClass
classC) -> Int -> RegClass -> RegClass -> Int
worst Int
i RegClass
classN RegClass
classC) [(Int, RegClass)]
countCs)