never executed always true always false
1
2
3 --------------------------------------------------------------------------------
4 -- | Deal with Cmm registers
5 --
6
7 module GHC.CmmToLlvm.Regs (
8 lmGlobalRegArg, lmGlobalRegVar, alwaysLive,
9 stgTBAA, baseN, stackN, heapN, rxN, topN, tbaa, getTBAA
10 ) where
11
12 import GHC.Prelude
13
14 import GHC.Llvm
15
16 import GHC.Cmm.Expr
17 import GHC.Platform
18 import GHC.Data.FastString
19 import GHC.Utils.Panic ( panic )
20 import GHC.Types.Unique
21
22 -- | Get the LlvmVar function variable storing the real register
23 lmGlobalRegVar :: Platform -> GlobalReg -> LlvmVar
24 lmGlobalRegVar platform = pVarLift . lmGlobalReg platform "_Var"
25
26 -- | Get the LlvmVar function argument storing the real register
27 lmGlobalRegArg :: Platform -> GlobalReg -> LlvmVar
28 lmGlobalRegArg platform = lmGlobalReg platform "_Arg"
29
30 {- Need to make sure the names here can't conflict with the unique generated
31 names. Uniques generated names containing only base62 chars. So using say
32 the '_' char guarantees this.
33 -}
34 lmGlobalReg :: Platform -> String -> GlobalReg -> LlvmVar
35 lmGlobalReg platform suf reg
36 = case reg of
37 BaseReg -> ptrGlobal $ "Base" ++ suf
38 Sp -> ptrGlobal $ "Sp" ++ suf
39 Hp -> ptrGlobal $ "Hp" ++ suf
40 VanillaReg 1 _ -> wordGlobal $ "R1" ++ suf
41 VanillaReg 2 _ -> wordGlobal $ "R2" ++ suf
42 VanillaReg 3 _ -> wordGlobal $ "R3" ++ suf
43 VanillaReg 4 _ -> wordGlobal $ "R4" ++ suf
44 VanillaReg 5 _ -> wordGlobal $ "R5" ++ suf
45 VanillaReg 6 _ -> wordGlobal $ "R6" ++ suf
46 VanillaReg 7 _ -> wordGlobal $ "R7" ++ suf
47 VanillaReg 8 _ -> wordGlobal $ "R8" ++ suf
48 VanillaReg 9 _ -> wordGlobal $ "R9" ++ suf
49 VanillaReg 10 _ -> wordGlobal $ "R10" ++ suf
50 SpLim -> wordGlobal $ "SpLim" ++ suf
51 FloatReg 1 -> floatGlobal $ "F1" ++ suf
52 FloatReg 2 -> floatGlobal $ "F2" ++ suf
53 FloatReg 3 -> floatGlobal $ "F3" ++ suf
54 FloatReg 4 -> floatGlobal $ "F4" ++ suf
55 FloatReg 5 -> floatGlobal $ "F5" ++ suf
56 FloatReg 6 -> floatGlobal $ "F6" ++ suf
57 DoubleReg 1 -> doubleGlobal $ "D1" ++ suf
58 DoubleReg 2 -> doubleGlobal $ "D2" ++ suf
59 DoubleReg 3 -> doubleGlobal $ "D3" ++ suf
60 DoubleReg 4 -> doubleGlobal $ "D4" ++ suf
61 DoubleReg 5 -> doubleGlobal $ "D5" ++ suf
62 DoubleReg 6 -> doubleGlobal $ "D6" ++ suf
63 XmmReg 1 -> xmmGlobal $ "XMM1" ++ suf
64 XmmReg 2 -> xmmGlobal $ "XMM2" ++ suf
65 XmmReg 3 -> xmmGlobal $ "XMM3" ++ suf
66 XmmReg 4 -> xmmGlobal $ "XMM4" ++ suf
67 XmmReg 5 -> xmmGlobal $ "XMM5" ++ suf
68 XmmReg 6 -> xmmGlobal $ "XMM6" ++ suf
69 YmmReg 1 -> ymmGlobal $ "YMM1" ++ suf
70 YmmReg 2 -> ymmGlobal $ "YMM2" ++ suf
71 YmmReg 3 -> ymmGlobal $ "YMM3" ++ suf
72 YmmReg 4 -> ymmGlobal $ "YMM4" ++ suf
73 YmmReg 5 -> ymmGlobal $ "YMM5" ++ suf
74 YmmReg 6 -> ymmGlobal $ "YMM6" ++ suf
75 ZmmReg 1 -> zmmGlobal $ "ZMM1" ++ suf
76 ZmmReg 2 -> zmmGlobal $ "ZMM2" ++ suf
77 ZmmReg 3 -> zmmGlobal $ "ZMM3" ++ suf
78 ZmmReg 4 -> zmmGlobal $ "ZMM4" ++ suf
79 ZmmReg 5 -> zmmGlobal $ "ZMM5" ++ suf
80 ZmmReg 6 -> zmmGlobal $ "ZMM6" ++ suf
81 MachSp -> wordGlobal $ "MachSp" ++ suf
82 _other -> panic $ "GHC.CmmToLlvm.Reg: GlobalReg (" ++ (show reg)
83 ++ ") not supported!"
84 -- LongReg, HpLim, CCSS, CurrentTSO, CurrentNusery, HpAlloc
85 -- EagerBlackholeInfo, GCEnter1, GCFun, BaseReg, PicBaseReg
86 where
87 wordGlobal name = LMNLocalVar (fsLit name) (llvmWord platform)
88 ptrGlobal name = LMNLocalVar (fsLit name) (llvmWordPtr platform)
89 floatGlobal name = LMNLocalVar (fsLit name) LMFloat
90 doubleGlobal name = LMNLocalVar (fsLit name) LMDouble
91 xmmGlobal name = LMNLocalVar (fsLit name) (LMVector 4 (LMInt 32))
92 ymmGlobal name = LMNLocalVar (fsLit name) (LMVector 8 (LMInt 32))
93 zmmGlobal name = LMNLocalVar (fsLit name) (LMVector 16 (LMInt 32))
94
95 -- | A list of STG Registers that should always be considered alive
96 alwaysLive :: [GlobalReg]
97 alwaysLive = [BaseReg, Sp, Hp, SpLim, HpLim, node]
98
99 -- | STG Type Based Alias Analysis hierarchy
100 stgTBAA :: [(Unique, LMString, Maybe Unique)]
101 stgTBAA
102 = [ (rootN, fsLit "root", Nothing)
103 , (topN, fsLit "top", Just rootN)
104 , (stackN, fsLit "stack", Just topN)
105 , (heapN, fsLit "heap", Just topN)
106 , (rxN, fsLit "rx", Just heapN)
107 , (baseN, fsLit "base", Just topN)
108 -- FIX: Not 100% sure if this hierarchy is complete. I think the big thing
109 -- is Sp is never aliased, so might want to change the hierarchy to have Sp
110 -- on its own branch that is never aliased (e.g never use top as a TBAA
111 -- node).
112 ]
113
114 -- | Id values
115 -- The `rootN` node is the root (there can be more than one) of the TBAA
116 -- hierarchy and as of LLVM 4.0 should *only* be referenced by other nodes. It
117 -- should never occur in any LLVM instruction statement.
118 rootN, topN, stackN, heapN, rxN, baseN :: Unique
119 rootN = getUnique (fsLit "GHC.CmmToLlvm.Regs.rootN")
120 topN = getUnique (fsLit "GHC.CmmToLlvm.Regs.topN")
121 stackN = getUnique (fsLit "GHC.CmmToLlvm.Regs.stackN")
122 heapN = getUnique (fsLit "GHC.CmmToLlvm.Regs.heapN")
123 rxN = getUnique (fsLit "GHC.CmmToLlvm.Regs.rxN")
124 baseN = getUnique (fsLit "GHC.CmmToLlvm.Regs.baseN")
125
126 -- | The TBAA metadata identifier
127 tbaa :: LMString
128 tbaa = fsLit "tbaa"
129
130 -- | Get the correct TBAA metadata information for this register type
131 getTBAA :: GlobalReg -> Unique
132 getTBAA BaseReg = baseN
133 getTBAA Sp = stackN
134 getTBAA Hp = heapN
135 getTBAA (VanillaReg _ _) = rxN
136 getTBAA _ = topN