GHC/CmmToAsm/Reg/Graph/X86.hs

    -- | 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
     = case reg of
            Reg c _         -> c

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

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

            ClassG16
             -> mkUniqSet   [ RegSub SubL16 (Reg ClassG32 i)
                            | i <- [0..7] ]

            ClassG8
             -> unionUniqSets
                    (mkUniqSet [ RegSub SubL8  (Reg ClassG32 i) | i <- [0..3] ])
                    (mkUniqSet [ RegSub SubL8H (Reg ClassG32 i) | i <- [0..3] ])

            ClassF64
             -> mkUniqSet   [ 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 ->
               let names = A.listArray (0,8)
                           [ "eax", "ebx", "ecx", "edx"
                           , "ebp", "esi", "edi", "esp" ]
               in Just $ names A.! i

            RegSub SubL16 (Reg ClassG32 i)
             | i <= 7 ->
               let names = A.listArray (0,8)
                           [ "ax", "bx", "cx", "dx"
                           , "bp", "si", "di", "sp"]
               in Just $ names A.! i

            RegSub SubL8  (Reg ClassG32 i)
             | i <= 3 ->
               let names = A.listArray (0,4) [ "al", "bl", "cl", "dl"]
               in Just $ names A.! i

            RegSub SubL8H (Reg ClassG32 i)
             | i <= 3 ->
               let names = A.listArray (0,4) [ "ah", "bh", "ch", "dh"]
               in Just $ names A.! i

            _         -> Nothing

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

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

             -- for eax, ebx, ecx, eds
             |  i <= 3
             -> mkUniqSet
             $ [ Reg ClassG32 i,   RegSub SubL16 reg
               , RegSub SubL8 reg, RegSub SubL8H reg ]

             -- for esi, edi, esp, ebp
             | 4 <= i && i <= 7
             -> mkUniqSet
             $ [ Reg ClassG32 i,   RegSub SubL16 reg ]

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

            -- 8 bit subregs alias the 32 and 16, but not the other 8 bit subreg
            RegSub SubL8  r@(Reg ClassG32 _)
             -> mkUniqSet $ [ r, RegSub SubL16 r, RegSub SubL8 r ]

            RegSub SubL8H r@(Reg ClassG32 _)
             -> mkUniqSet $ [ r, RegSub SubL16 r, RegSub SubL8H r ]

            -- fp
            Reg ClassF64 _
             -> unitUniqSet 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)