never executed always true always false
1 {-# LANGUAGE GADTs #-}
2 {-# LANGUAGE BangPatterns #-}
3
4 -----------------------------------------------------------------------------
5 --
6 -- Code generator utilities; mostly monadic
7 --
8 -- (c) The University of Glasgow 2004-2006
9 --
10 -----------------------------------------------------------------------------
11
12 module GHC.StgToCmm.CgUtils (
13 fixStgRegisters,
14 baseRegOffset,
15 get_Regtable_addr_from_offset,
16 regTableOffset,
17 get_GlobalReg_addr,
18 ) where
19
20 import GHC.Prelude
21
22 import GHC.Platform.Regs
23 import GHC.Platform
24 import GHC.Cmm
25 import GHC.Cmm.Dataflow.Block
26 import GHC.Cmm.Dataflow.Graph
27 import GHC.Cmm.Utils
28 import GHC.Cmm.CLabel
29 import GHC.Utils.Panic
30
31 -- -----------------------------------------------------------------------------
32 -- Information about global registers
33
34 baseRegOffset :: Platform -> GlobalReg -> Int
35 baseRegOffset platform reg = case reg of
36 VanillaReg 1 _ -> pc_OFFSET_StgRegTable_rR1 constants
37 VanillaReg 2 _ -> pc_OFFSET_StgRegTable_rR2 constants
38 VanillaReg 3 _ -> pc_OFFSET_StgRegTable_rR3 constants
39 VanillaReg 4 _ -> pc_OFFSET_StgRegTable_rR4 constants
40 VanillaReg 5 _ -> pc_OFFSET_StgRegTable_rR5 constants
41 VanillaReg 6 _ -> pc_OFFSET_StgRegTable_rR6 constants
42 VanillaReg 7 _ -> pc_OFFSET_StgRegTable_rR7 constants
43 VanillaReg 8 _ -> pc_OFFSET_StgRegTable_rR8 constants
44 VanillaReg 9 _ -> pc_OFFSET_StgRegTable_rR9 constants
45 VanillaReg 10 _ -> pc_OFFSET_StgRegTable_rR10 constants
46 VanillaReg n _ -> panic ("Registers above R10 are not supported (tried to use R" ++ show n ++ ")")
47 FloatReg 1 -> pc_OFFSET_StgRegTable_rF1 constants
48 FloatReg 2 -> pc_OFFSET_StgRegTable_rF2 constants
49 FloatReg 3 -> pc_OFFSET_StgRegTable_rF3 constants
50 FloatReg 4 -> pc_OFFSET_StgRegTable_rF4 constants
51 FloatReg 5 -> pc_OFFSET_StgRegTable_rF5 constants
52 FloatReg 6 -> pc_OFFSET_StgRegTable_rF6 constants
53 FloatReg n -> panic ("Registers above F6 are not supported (tried to use F" ++ show n ++ ")")
54 DoubleReg 1 -> pc_OFFSET_StgRegTable_rD1 constants
55 DoubleReg 2 -> pc_OFFSET_StgRegTable_rD2 constants
56 DoubleReg 3 -> pc_OFFSET_StgRegTable_rD3 constants
57 DoubleReg 4 -> pc_OFFSET_StgRegTable_rD4 constants
58 DoubleReg 5 -> pc_OFFSET_StgRegTable_rD5 constants
59 DoubleReg 6 -> pc_OFFSET_StgRegTable_rD6 constants
60 DoubleReg n -> panic ("Registers above D6 are not supported (tried to use D" ++ show n ++ ")")
61 XmmReg 1 -> pc_OFFSET_StgRegTable_rXMM1 constants
62 XmmReg 2 -> pc_OFFSET_StgRegTable_rXMM2 constants
63 XmmReg 3 -> pc_OFFSET_StgRegTable_rXMM3 constants
64 XmmReg 4 -> pc_OFFSET_StgRegTable_rXMM4 constants
65 XmmReg 5 -> pc_OFFSET_StgRegTable_rXMM5 constants
66 XmmReg 6 -> pc_OFFSET_StgRegTable_rXMM6 constants
67 XmmReg n -> panic ("Registers above XMM6 are not supported (tried to use XMM" ++ show n ++ ")")
68 YmmReg 1 -> pc_OFFSET_StgRegTable_rYMM1 constants
69 YmmReg 2 -> pc_OFFSET_StgRegTable_rYMM2 constants
70 YmmReg 3 -> pc_OFFSET_StgRegTable_rYMM3 constants
71 YmmReg 4 -> pc_OFFSET_StgRegTable_rYMM4 constants
72 YmmReg 5 -> pc_OFFSET_StgRegTable_rYMM5 constants
73 YmmReg 6 -> pc_OFFSET_StgRegTable_rYMM6 constants
74 YmmReg n -> panic ("Registers above YMM6 are not supported (tried to use YMM" ++ show n ++ ")")
75 ZmmReg 1 -> pc_OFFSET_StgRegTable_rZMM1 constants
76 ZmmReg 2 -> pc_OFFSET_StgRegTable_rZMM2 constants
77 ZmmReg 3 -> pc_OFFSET_StgRegTable_rZMM3 constants
78 ZmmReg 4 -> pc_OFFSET_StgRegTable_rZMM4 constants
79 ZmmReg 5 -> pc_OFFSET_StgRegTable_rZMM5 constants
80 ZmmReg 6 -> pc_OFFSET_StgRegTable_rZMM6 constants
81 ZmmReg n -> panic ("Registers above ZMM6 are not supported (tried to use ZMM" ++ show n ++ ")")
82 Sp -> pc_OFFSET_StgRegTable_rSp constants
83 SpLim -> pc_OFFSET_StgRegTable_rSpLim constants
84 LongReg 1 -> pc_OFFSET_StgRegTable_rL1 constants
85 LongReg n -> panic ("Registers above L1 are not supported (tried to use L" ++ show n ++ ")")
86 Hp -> pc_OFFSET_StgRegTable_rHp constants
87 HpLim -> pc_OFFSET_StgRegTable_rHpLim constants
88 CCCS -> pc_OFFSET_StgRegTable_rCCCS constants
89 CurrentTSO -> pc_OFFSET_StgRegTable_rCurrentTSO constants
90 CurrentNursery -> pc_OFFSET_StgRegTable_rCurrentNursery constants
91 HpAlloc -> pc_OFFSET_StgRegTable_rHpAlloc constants
92 EagerBlackholeInfo -> pc_OFFSET_stgEagerBlackholeInfo constants
93 GCEnter1 -> pc_OFFSET_stgGCEnter1 constants
94 GCFun -> pc_OFFSET_stgGCFun constants
95 BaseReg -> panic "GHC.StgToCmm.CgUtils.baseRegOffset:BaseReg"
96 PicBaseReg -> panic "GHC.StgToCmm.CgUtils.baseRegOffset:PicBaseReg"
97 MachSp -> panic "GHC.StgToCmm.CgUtils.baseRegOffset:MachSp"
98 UnwindReturnReg -> panic "GHC.StgToCmm.CgUtils.baseRegOffset:UnwindReturnReg"
99 where
100 !constants = platformConstants platform
101
102
103 -- -----------------------------------------------------------------------------
104 --
105 -- STG/Cmm GlobalReg
106 --
107 -- -----------------------------------------------------------------------------
108
109 -- | We map STG registers onto appropriate CmmExprs. Either they map
110 -- to real machine registers or stored as offsets from BaseReg. Given
111 -- a GlobalReg, get_GlobalReg_addr always produces the
112 -- register table address for it.
113 get_GlobalReg_addr :: Platform -> GlobalReg -> CmmExpr
114 get_GlobalReg_addr platform BaseReg = regTableOffset platform 0
115 get_GlobalReg_addr platform mid
116 = get_Regtable_addr_from_offset platform (baseRegOffset platform mid)
117
118 -- Calculate a literal representing an offset into the register table.
119 -- Used when we don't have an actual BaseReg to offset from.
120 regTableOffset :: Platform -> Int -> CmmExpr
121 regTableOffset platform n =
122 CmmLit (CmmLabelOff mkMainCapabilityLabel (pc_OFFSET_Capability_r (platformConstants platform) + n))
123
124 get_Regtable_addr_from_offset :: Platform -> Int -> CmmExpr
125 get_Regtable_addr_from_offset platform offset =
126 if haveRegBase platform
127 then cmmRegOff baseReg offset
128 else regTableOffset platform offset
129
130 -- | Fixup global registers so that they assign to locations within the
131 -- RegTable if they aren't pinned for the current target.
132 fixStgRegisters :: Platform -> RawCmmDecl -> RawCmmDecl
133 fixStgRegisters _ top@(CmmData _ _) = top
134
135 fixStgRegisters platform (CmmProc info lbl live graph) =
136 let graph' = modifyGraph (mapGraphBlocks (fixStgRegBlock platform)) graph
137 in CmmProc info lbl live graph'
138
139 fixStgRegBlock :: Platform -> Block CmmNode e x -> Block CmmNode e x
140 fixStgRegBlock platform block = mapBlock (fixStgRegStmt platform) block
141
142 fixStgRegStmt :: Platform -> CmmNode e x -> CmmNode e x
143 fixStgRegStmt platform stmt = fixAssign $ mapExpDeep fixExpr stmt
144 where
145 fixAssign stmt =
146 case stmt of
147 CmmAssign (CmmGlobal reg) src
148 -- MachSp isn't an STG register; it's merely here for tracking unwind
149 -- information
150 | reg == MachSp -> stmt
151 | otherwise ->
152 let baseAddr = get_GlobalReg_addr platform reg
153 in case reg `elem` activeStgRegs platform of
154 True -> CmmAssign (CmmGlobal reg) src
155 False -> CmmStore baseAddr src
156 other_stmt -> other_stmt
157
158 fixExpr expr = case expr of
159 -- MachSp isn't an STG; it's merely here for tracking unwind information
160 CmmReg (CmmGlobal MachSp) -> expr
161 CmmReg (CmmGlobal reg) ->
162 -- Replace register leaves with appropriate StixTrees for
163 -- the given target. MagicIds which map to a reg on this
164 -- arch are left unchanged. For the rest, BaseReg is taken
165 -- to mean the address of the reg table in MainCapability,
166 -- and for all others we generate an indirection to its
167 -- location in the register table.
168 case reg `elem` activeStgRegs platform of
169 True -> expr
170 False ->
171 let baseAddr = get_GlobalReg_addr platform reg
172 in case reg of
173 BaseReg -> baseAddr
174 _other -> CmmLoad baseAddr (globalRegType platform reg)
175
176 CmmRegOff (CmmGlobal reg) offset ->
177 -- RegOf leaves are just a shorthand form. If the reg maps
178 -- to a real reg, we keep the shorthand, otherwise, we just
179 -- expand it and defer to the above code.
180 case reg `elem` activeStgRegs platform of
181 True -> expr
182 False -> CmmMachOp (MO_Add (wordWidth platform)) [
183 fixExpr (CmmReg (CmmGlobal reg)),
184 CmmLit (CmmInt (fromIntegral offset)
185 (wordWidth platform))]
186
187 other_expr -> other_expr