    -- | 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 a. Num a => [a] -> a
    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)