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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
|
{-# LANGUAGE GADTs #-}
{-# LANGUAGE BangPatterns #-}
-----------------------------------------------------------------------------
--
-- Code generator utilities; mostly monadic
--
-- (c) The University of Glasgow 2004-2006
--
-----------------------------------------------------------------------------
module GHC.StgToCmm.CgUtils (
fixStgRegisters,
baseRegOffset,
get_Regtable_addr_from_offset,
regTableOffset,
get_GlobalReg_addr,
) where
import GHC.Prelude
import GHC.Platform.Regs
import GHC.Platform
import GHC.Cmm
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Utils
import GHC.Cmm.CLabel
import GHC.Utils.Panic
-- -----------------------------------------------------------------------------
-- Information about global registers
baseRegOffset :: Platform -> GlobalReg -> Int
baseRegOffset platform reg = case reg of
VanillaReg 1 _ -> pc_OFFSET_StgRegTable_rR1 constants
VanillaReg 2 _ -> pc_OFFSET_StgRegTable_rR2 constants
VanillaReg 3 _ -> pc_OFFSET_StgRegTable_rR3 constants
VanillaReg 4 _ -> pc_OFFSET_StgRegTable_rR4 constants
VanillaReg 5 _ -> pc_OFFSET_StgRegTable_rR5 constants
VanillaReg 6 _ -> pc_OFFSET_StgRegTable_rR6 constants
VanillaReg 7 _ -> pc_OFFSET_StgRegTable_rR7 constants
VanillaReg 8 _ -> pc_OFFSET_StgRegTable_rR8 constants
VanillaReg 9 _ -> pc_OFFSET_StgRegTable_rR9 constants
VanillaReg 10 _ -> pc_OFFSET_StgRegTable_rR10 constants
VanillaReg n _ -> panic ("Registers above R10 are not supported (tried to use R" ++ show n ++ ")")
FloatReg 1 -> pc_OFFSET_StgRegTable_rF1 constants
FloatReg 2 -> pc_OFFSET_StgRegTable_rF2 constants
FloatReg 3 -> pc_OFFSET_StgRegTable_rF3 constants
FloatReg 4 -> pc_OFFSET_StgRegTable_rF4 constants
FloatReg 5 -> pc_OFFSET_StgRegTable_rF5 constants
FloatReg 6 -> pc_OFFSET_StgRegTable_rF6 constants
FloatReg n -> panic ("Registers above F6 are not supported (tried to use F" ++ show n ++ ")")
DoubleReg 1 -> pc_OFFSET_StgRegTable_rD1 constants
DoubleReg 2 -> pc_OFFSET_StgRegTable_rD2 constants
DoubleReg 3 -> pc_OFFSET_StgRegTable_rD3 constants
DoubleReg 4 -> pc_OFFSET_StgRegTable_rD4 constants
DoubleReg 5 -> pc_OFFSET_StgRegTable_rD5 constants
DoubleReg 6 -> pc_OFFSET_StgRegTable_rD6 constants
DoubleReg n -> panic ("Registers above D6 are not supported (tried to use D" ++ show n ++ ")")
XmmReg 1 -> pc_OFFSET_StgRegTable_rXMM1 constants
XmmReg 2 -> pc_OFFSET_StgRegTable_rXMM2 constants
XmmReg 3 -> pc_OFFSET_StgRegTable_rXMM3 constants
XmmReg 4 -> pc_OFFSET_StgRegTable_rXMM4 constants
XmmReg 5 -> pc_OFFSET_StgRegTable_rXMM5 constants
XmmReg 6 -> pc_OFFSET_StgRegTable_rXMM6 constants
XmmReg n -> panic ("Registers above XMM6 are not supported (tried to use XMM" ++ show n ++ ")")
YmmReg 1 -> pc_OFFSET_StgRegTable_rYMM1 constants
YmmReg 2 -> pc_OFFSET_StgRegTable_rYMM2 constants
YmmReg 3 -> pc_OFFSET_StgRegTable_rYMM3 constants
YmmReg 4 -> pc_OFFSET_StgRegTable_rYMM4 constants
YmmReg 5 -> pc_OFFSET_StgRegTable_rYMM5 constants
YmmReg 6 -> pc_OFFSET_StgRegTable_rYMM6 constants
YmmReg n -> panic ("Registers above YMM6 are not supported (tried to use YMM" ++ show n ++ ")")
ZmmReg 1 -> pc_OFFSET_StgRegTable_rZMM1 constants
ZmmReg 2 -> pc_OFFSET_StgRegTable_rZMM2 constants
ZmmReg 3 -> pc_OFFSET_StgRegTable_rZMM3 constants
ZmmReg 4 -> pc_OFFSET_StgRegTable_rZMM4 constants
ZmmReg 5 -> pc_OFFSET_StgRegTable_rZMM5 constants
ZmmReg 6 -> pc_OFFSET_StgRegTable_rZMM6 constants
ZmmReg n -> panic ("Registers above ZMM6 are not supported (tried to use ZMM" ++ show n ++ ")")
Sp -> pc_OFFSET_StgRegTable_rSp constants
SpLim -> pc_OFFSET_StgRegTable_rSpLim constants
LongReg 1 -> pc_OFFSET_StgRegTable_rL1 constants
LongReg n -> panic ("Registers above L1 are not supported (tried to use L" ++ show n ++ ")")
Hp -> pc_OFFSET_StgRegTable_rHp constants
HpLim -> pc_OFFSET_StgRegTable_rHpLim constants
CCCS -> pc_OFFSET_StgRegTable_rCCCS constants
CurrentTSO -> pc_OFFSET_StgRegTable_rCurrentTSO constants
CurrentNursery -> pc_OFFSET_StgRegTable_rCurrentNursery constants
HpAlloc -> pc_OFFSET_StgRegTable_rHpAlloc constants
EagerBlackholeInfo -> pc_OFFSET_stgEagerBlackholeInfo constants
GCEnter1 -> pc_OFFSET_stgGCEnter1 constants
GCFun -> pc_OFFSET_stgGCFun constants
BaseReg -> panic "GHC.StgToCmm.CgUtils.baseRegOffset:BaseReg"
PicBaseReg -> panic "GHC.StgToCmm.CgUtils.baseRegOffset:PicBaseReg"
MachSp -> panic "GHC.StgToCmm.CgUtils.baseRegOffset:MachSp"
UnwindReturnReg -> panic "GHC.StgToCmm.CgUtils.baseRegOffset:UnwindReturnReg"
where
!constants = platformConstants platform
-- -----------------------------------------------------------------------------
--
-- STG/Cmm GlobalReg
--
-- -----------------------------------------------------------------------------
-- | We map STG registers onto appropriate CmmExprs. Either they map
-- to real machine registers or stored as offsets from BaseReg. Given
-- a GlobalReg, get_GlobalReg_addr always produces the
-- register table address for it.
get_GlobalReg_addr :: Platform -> GlobalReg -> CmmExpr
get_GlobalReg_addr platform BaseReg = regTableOffset platform 0
get_GlobalReg_addr platform mid
= get_Regtable_addr_from_offset platform (baseRegOffset platform mid)
-- Calculate a literal representing an offset into the register table.
-- Used when we don't have an actual BaseReg to offset from.
regTableOffset :: Platform -> Int -> CmmExpr
regTableOffset platform n =
CmmLit (CmmLabelOff mkMainCapabilityLabel (pc_OFFSET_Capability_r (platformConstants platform) + n))
get_Regtable_addr_from_offset :: Platform -> Int -> CmmExpr
get_Regtable_addr_from_offset platform offset =
if haveRegBase platform
then cmmRegOff baseReg offset
else regTableOffset platform offset
-- | Fixup global registers so that they assign to locations within the
-- RegTable if they aren't pinned for the current target.
fixStgRegisters :: Platform -> RawCmmDecl -> RawCmmDecl
fixStgRegisters _ top@(CmmData _ _) = top
fixStgRegisters platform (CmmProc info lbl live graph) =
let graph' = modifyGraph (mapGraphBlocks (fixStgRegBlock platform)) graph
in CmmProc info lbl live graph'
fixStgRegBlock :: Platform -> Block CmmNode e x -> Block CmmNode e x
fixStgRegBlock platform block = mapBlock (fixStgRegStmt platform) block
fixStgRegStmt :: Platform -> CmmNode e x -> CmmNode e x
fixStgRegStmt platform stmt = fixAssign $ mapExpDeep fixExpr stmt
where
fixAssign stmt =
case stmt of
CmmAssign (CmmGlobal reg) src
-- MachSp isn't an STG register; it's merely here for tracking unwind
-- information
| reg == MachSp -> stmt
| otherwise ->
let baseAddr = get_GlobalReg_addr platform reg
in case reg `elem` activeStgRegs platform of
True -> CmmAssign (CmmGlobal reg) src
False -> CmmStore baseAddr src
other_stmt -> other_stmt
fixExpr expr = case expr of
-- MachSp isn't an STG; it's merely here for tracking unwind information
CmmReg (CmmGlobal MachSp) -> expr
CmmReg (CmmGlobal reg) ->
-- Replace register leaves with appropriate StixTrees for
-- the given target. MagicIds which map to a reg on this
-- arch are left unchanged. For the rest, BaseReg is taken
-- to mean the address of the reg table in MainCapability,
-- and for all others we generate an indirection to its
-- location in the register table.
case reg `elem` activeStgRegs platform of
True -> expr
False ->
let baseAddr = get_GlobalReg_addr platform reg
in case reg of
BaseReg -> baseAddr
_other -> CmmLoad baseAddr (globalRegType platform reg)
CmmRegOff (CmmGlobal reg) offset ->
-- RegOf leaves are just a shorthand form. If the reg maps
-- to a real reg, we keep the shorthand, otherwise, we just
-- expand it and defer to the above code.
case reg `elem` activeStgRegs platform of
True -> expr
False -> CmmMachOp (MO_Add (wordWidth platform)) [
fixExpr (CmmReg (CmmGlobal reg)),
CmmLit (CmmInt (fromIntegral offset)
(wordWidth platform))]
other_expr -> other_expr
|
