--------------------------------------------------------------------------------
-- | Deal with Cmm registers
--

module GHC.CmmToLlvm.Regs (
        lmGlobalRegArg, lmGlobalRegVar, alwaysLive,
        stgTBAA, baseN, stackN, heapN, rxN, topN, tbaa, getTBAA
    ) where

import GHC.Prelude

import GHC.Llvm

import GHC.Cmm.Expr
import GHC.CmmToAsm.Format
import GHC.Platform
import GHC.Data.FastString
import GHC.Utils.Panic ( panic )
import GHC.Types.Unique


-- | Get the LlvmVar function variable storing the real register
lmGlobalRegVar :: Platform -> GlobalRegUse -> LlvmVar
lmGlobalRegVar :: Platform -> GlobalRegUse -> LlvmVar
lmGlobalRegVar Platform
platform = LlvmVar -> LlvmVar
pVarLift (LlvmVar -> LlvmVar)
-> (GlobalRegUse -> LlvmVar) -> GlobalRegUse -> LlvmVar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> String -> GlobalRegUse -> LlvmVar
lmGlobalReg Platform
platform String
"_Var"

-- | Get the LlvmVar function argument storing the real register
lmGlobalRegArg :: Platform -> GlobalRegUse -> LlvmVar
lmGlobalRegArg :: Platform -> GlobalRegUse -> LlvmVar
lmGlobalRegArg Platform
platform = Platform -> String -> GlobalRegUse -> LlvmVar
lmGlobalReg Platform
platform String
"_Arg"

{- Need to make sure the names here can't conflict with the unique generated
   names. Uniques generated names containing only base62 chars. So using say
   the '_' char guarantees this.
-}
lmGlobalReg :: Platform -> String -> GlobalRegUse -> LlvmVar
lmGlobalReg :: Platform -> String -> GlobalRegUse -> LlvmVar
lmGlobalReg Platform
platform String
suf (GlobalRegUse GlobalReg
reg CmmType
ty)
  = case GlobalReg
reg of
        GlobalReg
BaseReg        -> String -> LlvmVar
ptrGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"Base" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        GlobalReg
Sp             -> String -> LlvmVar
ptrGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"Sp" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        GlobalReg
Hp             -> String -> LlvmVar
ptrGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"Hp" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg Int
1   -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"R1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg Int
2   -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"R2" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg Int
3   -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"R3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg Int
4   -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"R4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg Int
5   -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"R5" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg Int
6   -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"R6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg Int
7   -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"R7" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg Int
8   -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"R8" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg Int
9   -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"R9" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg Int
10  -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"R10" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        GlobalReg
SpLim          -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"SpLim" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        FloatReg Int
1     -> String -> LlvmVar
floatGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"F1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        FloatReg Int
2     -> String -> LlvmVar
floatGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"F2" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        FloatReg Int
3     -> String -> LlvmVar
floatGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"F3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        FloatReg Int
4     -> String -> LlvmVar
floatGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"F4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        FloatReg Int
5     -> String -> LlvmVar
floatGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"F5" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        FloatReg Int
6     -> String -> LlvmVar
floatGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"F6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        DoubleReg Int
1    -> String -> LlvmVar
doubleGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"D1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        DoubleReg Int
2    -> String -> LlvmVar
doubleGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"D2" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        DoubleReg Int
3    -> String -> LlvmVar
doubleGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"D3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        DoubleReg Int
4    -> String -> LlvmVar
doubleGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"D4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        DoubleReg Int
5    -> String -> LlvmVar
doubleGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"D5" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        DoubleReg Int
6    -> String -> LlvmVar
doubleGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"D6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        XmmReg Int
1       -> String -> LlvmVar
xmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"XMM1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        XmmReg Int
2       -> String -> LlvmVar
xmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"XMM2" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        XmmReg Int
3       -> String -> LlvmVar
xmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"XMM3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        XmmReg Int
4       -> String -> LlvmVar
xmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"XMM4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        XmmReg Int
5       -> String -> LlvmVar
xmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"XMM5" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        XmmReg Int
6       -> String -> LlvmVar
xmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"XMM6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        YmmReg Int
1       -> String -> LlvmVar
ymmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"YMM1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        YmmReg Int
2       -> String -> LlvmVar
ymmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"YMM2" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        YmmReg Int
3       -> String -> LlvmVar
ymmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"YMM3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        YmmReg Int
4       -> String -> LlvmVar
ymmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"YMM4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        YmmReg Int
5       -> String -> LlvmVar
ymmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"YMM5" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        YmmReg Int
6       -> String -> LlvmVar
ymmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"YMM6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        ZmmReg Int
1       -> String -> LlvmVar
zmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"ZMM1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        ZmmReg Int
2       -> String -> LlvmVar
zmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"ZMM2" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        ZmmReg Int
3       -> String -> LlvmVar
zmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"ZMM3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        ZmmReg Int
4       -> String -> LlvmVar
zmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"ZMM4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        ZmmReg Int
5       -> String -> LlvmVar
zmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"ZMM5" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        ZmmReg Int
6       -> String -> LlvmVar
zmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"ZMM6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        GlobalReg
MachSp         -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"MachSp" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        GlobalReg
_other         -> String -> LlvmVar
forall a. HasCallStack => String -> a
panic (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ String
"GHC.CmmToLlvm.Reg: GlobalReg (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (GlobalReg -> String
forall a. Show a => a -> String
show GlobalReg
reg)
                                String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") not supported!"
        -- LongReg, HpLim, CCSS, CurrentTSO, CurrentNusery, HpAlloc
        -- EagerBlackholeInfo, GCEnter1, GCFun, BaseReg, PicBaseReg
    where
        wordGlobal :: String -> LlvmVar
wordGlobal   String
name = FastString -> LlvmType -> LlvmVar
LMNLocalVar (String -> FastString
fsLit String
name) (Platform -> LlvmType
llvmWord Platform
platform)
        ptrGlobal :: String -> LlvmVar
ptrGlobal    String
name = FastString -> LlvmType -> LlvmVar
LMNLocalVar (String -> FastString
fsLit String
name) (Platform -> LlvmType
llvmWordPtr Platform
platform)
        floatGlobal :: String -> LlvmVar
floatGlobal  String
name = FastString -> LlvmType -> LlvmVar
LMNLocalVar (String -> FastString
fsLit String
name) LlvmType
LMFloat
        doubleGlobal :: String -> LlvmVar
doubleGlobal String
name = FastString -> LlvmType -> LlvmVar
LMNLocalVar (String -> FastString
fsLit String
name) LlvmType
LMDouble
        fmt :: Format
fmt = CmmType -> Format
cmmTypeFormat CmmType
ty
        xmmGlobal :: String -> LlvmVar
xmmGlobal    String
name = FastString -> LlvmType -> LlvmVar
LMNLocalVar (String -> FastString
fsLit String
name) (Format -> LlvmType
formatLlvmType Format
fmt)
        ymmGlobal :: String -> LlvmVar
ymmGlobal    String
name = FastString -> LlvmType -> LlvmVar
LMNLocalVar (String -> FastString
fsLit String
name) (Format -> LlvmType
formatLlvmType Format
fmt)
        zmmGlobal :: String -> LlvmVar
zmmGlobal    String
name = FastString -> LlvmType -> LlvmVar
LMNLocalVar (String -> FastString
fsLit String
name) (Format -> LlvmType
formatLlvmType Format
fmt)

formatLlvmType :: Format -> LlvmType
formatLlvmType :: Format -> LlvmType
formatLlvmType Format
II8 = Int -> LlvmType
LMInt Int
8
formatLlvmType Format
II16 = Int -> LlvmType
LMInt Int
16
formatLlvmType Format
II32 = Int -> LlvmType
LMInt Int
32
formatLlvmType Format
II64 = Int -> LlvmType
LMInt Int
64
formatLlvmType Format
FF32 = LlvmType
LMFloat
formatLlvmType Format
FF64 = LlvmType
LMDouble
formatLlvmType (VecFormat Int
l ScalarFormat
sFmt) = Int -> LlvmType -> LlvmType
LMVector Int
l (Format -> LlvmType
formatLlvmType (Format -> LlvmType) -> Format -> LlvmType
forall a b. (a -> b) -> a -> b
$ ScalarFormat -> Format
scalarFormatFormat ScalarFormat
sFmt)

-- | A list of STG Registers that should always be considered alive
alwaysLive :: Platform -> [GlobalRegUse]
alwaysLive :: Platform -> [GlobalRegUse]
alwaysLive Platform
platform =
  [ GlobalReg -> CmmType -> GlobalRegUse
GlobalRegUse GlobalReg
r (Platform -> GlobalReg -> CmmType
globalRegSpillType Platform
platform GlobalReg
r)
  | GlobalReg
r <- [GlobalReg
BaseReg, GlobalReg
Sp, GlobalReg
Hp, GlobalReg
SpLim, GlobalReg
HpLim, GlobalReg
node]
  ]

-- | STG Type Based Alias Analysis hierarchy
stgTBAA :: [(Unique, LMString, Maybe Unique)]
stgTBAA :: [(Unique, FastString, Maybe Unique)]
stgTBAA
  = [ (Unique
rootN,  String -> FastString
fsLit String
"root",   Maybe Unique
forall a. Maybe a
Nothing)
    , (Unique
topN,   String -> FastString
fsLit String
"top",   Unique -> Maybe Unique
forall a. a -> Maybe a
Just Unique
rootN)
    , (Unique
stackN, String -> FastString
fsLit String
"stack", Unique -> Maybe Unique
forall a. a -> Maybe a
Just Unique
topN)
    , (Unique
heapN,  String -> FastString
fsLit String
"heap",  Unique -> Maybe Unique
forall a. a -> Maybe a
Just Unique
topN)
    , (Unique
rxN,    String -> FastString
fsLit String
"rx",    Unique -> Maybe Unique
forall a. a -> Maybe a
Just Unique
heapN)
    , (Unique
baseN,  String -> FastString
fsLit String
"base",  Unique -> Maybe Unique
forall a. a -> Maybe a
Just Unique
topN)
    -- FIX: Not 100% sure if this hierarchy is complete.  I think the big thing
    -- is Sp is never aliased, so might want to change the hierarchy to have Sp
    -- on its own branch that is never aliased (e.g never use top as a TBAA
    -- node).
    ]

-- | Id values
-- The `rootN` node is the root (there can be more than one) of the TBAA
-- hierarchy and as of LLVM 4.0 should *only* be referenced by other nodes. It
-- should never occur in any LLVM instruction statement.
rootN, topN, stackN, heapN, rxN, baseN :: Unique
rootN :: Unique
rootN  = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (String -> FastString
fsLit String
"GHC.CmmToLlvm.Regs.rootN")
topN :: Unique
topN   = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (String -> FastString
fsLit String
"GHC.CmmToLlvm.Regs.topN")
stackN :: Unique
stackN = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (String -> FastString
fsLit String
"GHC.CmmToLlvm.Regs.stackN")
heapN :: Unique
heapN  = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (String -> FastString
fsLit String
"GHC.CmmToLlvm.Regs.heapN")
rxN :: Unique
rxN    = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (String -> FastString
fsLit String
"GHC.CmmToLlvm.Regs.rxN")
baseN :: Unique
baseN  = FastString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (String -> FastString
fsLit String
"GHC.CmmToLlvm.Regs.baseN")

-- | The TBAA metadata identifier
tbaa :: LMString
tbaa :: FastString
tbaa = String -> FastString
fsLit String
"tbaa"

-- | Get the correct TBAA metadata information for this register type
getTBAA :: GlobalReg -> Unique
getTBAA :: GlobalReg -> Unique
getTBAA GlobalReg
BaseReg        = Unique
baseN
getTBAA GlobalReg
Sp             = Unique
stackN
getTBAA GlobalReg
Hp             = Unique
heapN
getTBAA (VanillaReg Int
_) = Unique
rxN
getTBAA GlobalReg
_              = Unique
topN