summaryrefslogtreecommitdiff
path: root/compiler/GHC/CmmToLlvm/Regs.hs
blob: af2a88c4c9366aa7e9cf42818e3293b767d95bf2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
{-# LANGUAGE CPP #-}

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

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

#include "HsVersions.h"

import GhcPrelude

import GHC.Llvm

import GHC.Cmm.Expr
import GHC.Driver.Session
import FastString
import Outputable ( panic )
import Unique

-- | Get the LlvmVar function variable storing the real register
lmGlobalRegVar :: DynFlags -> GlobalReg -> LlvmVar
lmGlobalRegVar dflags = pVarLift . lmGlobalReg dflags "_Var"

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

-- | A list of STG Registers that should always be considered alive
alwaysLive :: [GlobalReg]
alwaysLive = [BaseReg, Sp, Hp, SpLim, HpLim, node]

-- | STG Type Based Alias Analysis hierarchy
stgTBAA :: [(Unique, LMString, Maybe Unique)]
stgTBAA
  = [ (rootN,  fsLit "root",   Nothing)
    , (topN,   fsLit "top",   Just rootN)
    , (stackN, fsLit "stack", Just topN)
    , (heapN,  fsLit "heap",  Just topN)
    , (rxN,    fsLit "rx",    Just heapN)
    , (baseN,  fsLit "base",  Just 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  = getUnique (fsLit "GHC.CmmToLlvm.Regs.rootN")
topN   = getUnique (fsLit "GHC.CmmToLlvm.Regs.topN")
stackN = getUnique (fsLit "GHC.CmmToLlvm.Regs.stackN")
heapN  = getUnique (fsLit "GHC.CmmToLlvm.Regs.heapN")
rxN    = getUnique (fsLit "GHC.CmmToLlvm.Regs.rxN")
baseN  = getUnique (fsLit "GHC.CmmToLlvm.Regs.baseN")

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

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