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
|
--------------------------------------------------------------------------------
-- | Deal with Cmm registers
--
module LlvmCodeGen.Regs (
lmGlobalRegArg, lmGlobalRegVar, alwaysLive,
stgTBAA, baseN, stackN, heapN, rxN, otherN, tbaa, getTBAA
) where
#include "HsVersions.h"
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 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
_other -> panic $ "LlvmCodeGen.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))
-- | 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
= [ (topN, fsLit "top", Nothing)
, (stackN, fsLit "stack", Just topN)
, (heapN, fsLit "heap", Just topN)
, (rxN, fsLit "rx", Just heapN)
, (baseN, fsLit "base", Just topN)
-- FIX: Not 100% sure about 'others' place. Might need to be under 'heap'.
-- OR I think the big thing is Sp is never aliased, so might want
-- to change the hieracy to have Sp on its own branch that is never
-- aliased (e.g never use top as a TBAA node).
, (otherN, fsLit "other", Just topN)
]
-- | Id values
topN, stackN, heapN, rxN, baseN, otherN :: Unique
topN = getUnique (fsLit "LlvmCodeGen.Regs.topN")
stackN = getUnique (fsLit "LlvmCodeGen.Regs.stackN")
heapN = getUnique (fsLit "LlvmCodeGen.Regs.heapN")
rxN = getUnique (fsLit "LlvmCodeGen.Regs.rxN")
baseN = getUnique (fsLit "LlvmCodeGen.Regs.baseN")
otherN = getUnique (fsLit "LlvmCodeGen.Regs.otherN")
-- | 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
|
