{-# LANGUAGE CPP #-}

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

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

#include "HsVersions.h"

import GhcPrelude

import Llvm

import CmmExpr
import DynFlags
import FastString
import Outputable ( panic )
import Unique

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

-- | Get the LlvmVar function argument storing the real register
lmGlobalRegArg :: DynFlags -> GlobalReg -> LlvmVar
lmGlobalRegArg :: DynFlags -> GlobalReg -> LlvmVar
lmGlobalRegArg dflags :: DynFlags
dflags = DynFlags -> String -> GlobalReg -> LlvmVar
lmGlobalReg DynFlags
dflags "_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 :: DynFlags -> String -> GlobalReg -> LlvmVar
lmGlobalReg :: DynFlags -> String -> GlobalReg -> LlvmVar
lmGlobalReg dflags :: DynFlags
dflags suf :: String
suf reg :: GlobalReg
reg
  = case GlobalReg
reg of
        BaseReg        -> String -> LlvmVar
ptrGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "Base" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        Sp             -> String -> LlvmVar
ptrGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "Sp" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        Hp             -> String -> LlvmVar
ptrGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "Hp" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg 1 _ -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "R1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg 2 _ -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "R2" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg 3 _ -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "R3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg 4 _ -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "R4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg 5 _ -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "R5" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg 6 _ -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "R6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg 7 _ -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "R7" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        VanillaReg 8 _ -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "R8" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        SpLim          -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "SpLim" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        FloatReg 1     -> String -> LlvmVar
floatGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$"F1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        FloatReg 2     -> String -> LlvmVar
floatGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$"F2" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        FloatReg 3     -> String -> LlvmVar
floatGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$"F3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        FloatReg 4     -> String -> LlvmVar
floatGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$"F4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        FloatReg 5     -> String -> LlvmVar
floatGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$"F5" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        FloatReg 6     -> String -> LlvmVar
floatGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$"F6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        DoubleReg 1    -> String -> LlvmVar
doubleGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "D1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        DoubleReg 2    -> String -> LlvmVar
doubleGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "D2" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        DoubleReg 3    -> String -> LlvmVar
doubleGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "D3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        DoubleReg 4    -> String -> LlvmVar
doubleGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "D4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        DoubleReg 5    -> String -> LlvmVar
doubleGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "D5" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        DoubleReg 6    -> String -> LlvmVar
doubleGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "D6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        XmmReg 1       -> String -> LlvmVar
xmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "XMM1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        XmmReg 2       -> String -> LlvmVar
xmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "XMM2" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        XmmReg 3       -> String -> LlvmVar
xmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "XMM3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        XmmReg 4       -> String -> LlvmVar
xmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "XMM4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        XmmReg 5       -> String -> LlvmVar
xmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "XMM5" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        XmmReg 6       -> String -> LlvmVar
xmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "XMM6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        YmmReg 1       -> String -> LlvmVar
ymmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "YMM1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        YmmReg 2       -> String -> LlvmVar
ymmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "YMM2" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        YmmReg 3       -> String -> LlvmVar
ymmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "YMM3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        YmmReg 4       -> String -> LlvmVar
ymmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "YMM4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        YmmReg 5       -> String -> LlvmVar
ymmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "YMM5" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        YmmReg 6       -> String -> LlvmVar
ymmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "YMM6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        ZmmReg 1       -> String -> LlvmVar
zmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "ZMM1" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        ZmmReg 2       -> String -> LlvmVar
zmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "ZMM2" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        ZmmReg 3       -> String -> LlvmVar
zmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "ZMM3" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        ZmmReg 4       -> String -> LlvmVar
zmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "ZMM4" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        ZmmReg 5       -> String -> LlvmVar
zmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "ZMM5" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        ZmmReg 6       -> String -> LlvmVar
zmmGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "ZMM6" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        MachSp         -> String -> LlvmVar
wordGlobal (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "MachSp" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suf
        _other :: GlobalReg
_other         -> String -> LlvmVar
forall a. String -> a
panic (String -> LlvmVar) -> String -> LlvmVar
forall a b. (a -> b) -> a -> b
$ "LlvmCodeGen.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]
++ ") not supported!"
        -- LongReg, HpLim, CCSS, CurrentTSO, CurrentNusery, HpAlloc
        -- EagerBlackholeInfo, GCEnter1, GCFun, BaseReg, PicBaseReg
    where
        wordGlobal :: String -> LlvmVar
wordGlobal   name :: String
name = LMString -> LlvmType -> LlvmVar
LMNLocalVar (String -> LMString
fsLit String
name) (DynFlags -> LlvmType
llvmWord DynFlags
dflags)
        ptrGlobal :: String -> LlvmVar
ptrGlobal    name :: String
name = LMString -> LlvmType -> LlvmVar
LMNLocalVar (String -> LMString
fsLit String
name) (DynFlags -> LlvmType
llvmWordPtr DynFlags
dflags)
        floatGlobal :: String -> LlvmVar
floatGlobal  name :: String
name = LMString -> LlvmType -> LlvmVar
LMNLocalVar (String -> LMString
fsLit String
name) LlvmType
LMFloat
        doubleGlobal :: String -> LlvmVar
doubleGlobal name :: String
name = LMString -> LlvmType -> LlvmVar
LMNLocalVar (String -> LMString
fsLit String
name) LlvmType
LMDouble
        xmmGlobal :: String -> LlvmVar
xmmGlobal    name :: String
name = LMString -> LlvmType -> LlvmVar
LMNLocalVar (String -> LMString
fsLit String
name) (Int -> LlvmType -> LlvmType
LMVector 4 (Int -> LlvmType
LMInt 32))
        ymmGlobal :: String -> LlvmVar
ymmGlobal    name :: String
name = LMString -> LlvmType -> LlvmVar
LMNLocalVar (String -> LMString
fsLit String
name) (Int -> LlvmType -> LlvmType
LMVector 8 (Int -> LlvmType
LMInt 32))
        zmmGlobal :: String -> LlvmVar
zmmGlobal    name :: String
name = LMString -> LlvmType -> LlvmVar
LMNLocalVar (String -> LMString
fsLit String
name) (Int -> LlvmType -> LlvmType
LMVector 16 (Int -> LlvmType
LMInt 32))

-- | A list of STG Registers that should always be considered alive
alwaysLive :: [GlobalReg]
alwaysLive :: [GlobalReg]
alwaysLive = [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, LMString, Maybe Unique)]
stgTBAA
  = [ (Unique
rootN,  String -> LMString
fsLit "root",   Maybe Unique
forall a. Maybe a
Nothing)
    , (Unique
topN,   String -> LMString
fsLit "top",   Unique -> Maybe Unique
forall a. a -> Maybe a
Just Unique
rootN)
    , (Unique
stackN, String -> LMString
fsLit "stack", Unique -> Maybe Unique
forall a. a -> Maybe a
Just Unique
topN)
    , (Unique
heapN,  String -> LMString
fsLit "heap",  Unique -> Maybe Unique
forall a. a -> Maybe a
Just Unique
topN)
    , (Unique
rxN,    String -> LMString
fsLit "rx",    Unique -> Maybe Unique
forall a. a -> Maybe a
Just Unique
heapN)
    , (Unique
baseN,  String -> LMString
fsLit "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  = LMString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (String -> LMString
fsLit "LlvmCodeGen.Regs.rootN")
topN :: Unique
topN   = LMString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (String -> LMString
fsLit "LlvmCodeGen.Regs.topN")
stackN :: Unique
stackN = LMString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (String -> LMString
fsLit "LlvmCodeGen.Regs.stackN")
heapN :: Unique
heapN  = LMString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (String -> LMString
fsLit "LlvmCodeGen.Regs.heapN")
rxN :: Unique
rxN    = LMString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (String -> LMString
fsLit "LlvmCodeGen.Regs.rxN")
baseN :: Unique
baseN  = LMString -> Unique
forall a. Uniquable a => a -> Unique
getUnique (String -> LMString
fsLit "LlvmCodeGen.Regs.baseN")

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

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