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
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
|
-----------------------------------------------------------------------------
--
-- Stg to C-- code generation: the binding environment
--
-- (c) The University of Glasgow 2004-2006
--
-----------------------------------------------------------------------------
module GHC.StgToCmm.Env (
CgIdInfo,
litIdInfo, lneIdInfo, rhsIdInfo, mkRhsInit,
idInfoToAmode,
addBindC, addBindsC,
bindArgsToRegs, bindToReg, rebindToReg,
bindArgToReg, bindArgToGivenReg, idToReg,
getCgIdInfo, getCgInfo_maybe,
maybeLetNoEscape,
) where
import GHC.Prelude
import GHC.Platform
import GHC.StgToCmm.Monad
import GHC.StgToCmm.Closure
import GHC.Cmm.CLabel
import GHC.Cmm.BlockId
import GHC.Cmm.Expr
import GHC.Cmm.Utils
import GHC.Types.Id
import GHC.Cmm.Graph
import GHC.Types.Name
import GHC.Core.Type
import GHC.Builtin.Types.Prim
import GHC.Types.Unique.FM
import GHC.Types.Var.Env
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Builtin.Names (getUnique)
import GHC.Utils.Misc
-------------------------------------
-- Manipulating CgIdInfo
-------------------------------------
mkCgIdInfo :: Id -> LambdaFormInfo -> CmmExpr -> CgIdInfo
mkCgIdInfo id lf expr
= CgIdInfo { cg_id = id, cg_lf = lf
, cg_loc = CmmLoc expr }
litIdInfo :: Platform -> Id -> LambdaFormInfo -> CmmLit -> CgIdInfo
litIdInfo platform id lf lit
= CgIdInfo { cg_id = id, cg_lf = lf
, cg_loc = CmmLoc (addDynTag platform (CmmLit lit) tag) }
where
tag = lfDynTag platform lf
lneIdInfo :: Platform -> Id -> [NonVoid Id] -> CgIdInfo
lneIdInfo platform id regs
= CgIdInfo { cg_id = id, cg_lf = lf
, cg_loc = LneLoc blk_id (map (idToReg platform) regs) }
where
lf = mkLFLetNoEscape
blk_id = mkBlockId (idUnique id)
-- Construct the cgIdInfo from it's parts and determine which
-- register to put the value in.
rhsIdInfo :: Id -> LambdaFormInfo -> FCode (CgIdInfo, LocalReg)
rhsIdInfo id lf_info
= do platform <- getPlatform
reg <- newTemp (gcWord platform)
return (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)), reg)
mkRhsInit :: Platform -> LocalReg -> LambdaFormInfo -> CmmExpr -> CmmAGraph
mkRhsInit platform reg lf_info expr
= mkAssign (CmmLocal reg) (addDynTag platform expr (lfDynTag platform lf_info))
idInfoToAmode :: CgIdInfo -> CmmExpr
-- Returns a CmmExpr for the *tagged* pointer
idInfoToAmode CgIdInfo { cg_loc = CmmLoc e } = e
idInfoToAmode cg_info
= pprPanic "idInfoToAmode" (ppr (cg_id cg_info)) -- LneLoc
-- | A tag adds a byte offset to the pointer
addDynTag :: Platform -> CmmExpr -> DynTag -> CmmExpr
addDynTag = cmmOffsetB
maybeLetNoEscape :: CgIdInfo -> Maybe (BlockId, [LocalReg])
maybeLetNoEscape CgIdInfo { cg_loc = LneLoc blk_id args} = Just (blk_id, args)
maybeLetNoEscape _other = Nothing
---------------------------------------------------------
-- The binding environment
--
-- There are three basic routines, for adding (addBindC),
-- modifying(modifyBindC) and looking up (getCgIdInfo) bindings.
---------------------------------------------------------
addBindC :: CgIdInfo -> FCode ()
addBindC stuff_to_bind = do
binds <- getBinds
setBinds $ extendVarEnv binds (cg_id stuff_to_bind) stuff_to_bind
addBindsC :: [CgIdInfo] -> FCode ()
addBindsC new_bindings = do
binds <- getBinds
let new_binds = foldl' (\ binds info -> extendVarEnv binds (cg_id info) info)
binds
new_bindings
setBinds new_binds
-- Inside GHC the average module creates 385 external references
-- with notable cgIdInfo (so not generated by mkLFArgument).
-- On average 200 of these are covered by True/False/[]
-- and nullary constructors make up ~80.
-- One would think it would be worthwhile to cache these.
-- Sadly it's not. See #16937
getCgIdInfo :: HasDebugCallStack => Id -> FCode CgIdInfo
getCgIdInfo id
= do { platform <- getPlatform
; local_binds <- getBinds -- Try local bindings first
; case lookupVarEnv local_binds id of {
Just info -> -- pprTrace "getCgIdInfoLocal" (ppr id) $
return info ;
Nothing -> do {
-- Should be imported; make up a CgIdInfo for it
let name = idName id
; if isExternalName name then
let ext_lbl
| isBoxedType (idType id)
= mkClosureLabel name $ idCafInfo id
| isUnliftedType (idType id)
-- An unlifted external Id must refer to a top-level
-- string literal. See Note [Bytes label] in "GHC.Cmm.CLabel".
= assert (idType id `eqType` addrPrimTy) $
mkBytesLabel name
| otherwise
= pprPanic "GHC.StgToCmm.Env: label not found" (ppr id <+> dcolon <+> ppr (idType id))
in return $
litIdInfo platform id (mkLFImported id) (CmmLabel ext_lbl)
else
cgLookupPanic id -- Bug
}}}
-- | Retrieve cg info for a name if it already exists.
getCgInfo_maybe :: Name -> FCode (Maybe CgIdInfo)
getCgInfo_maybe name
= do { local_binds <- getBinds -- Try local bindings first
; return $ lookupVarEnv_Directly local_binds (getUnique name) }
cgLookupPanic :: HasDebugCallStack => Id -> FCode a
cgLookupPanic id
= do local_binds <- getBinds
pprPanic "GHC.StgToCmm.Env: variable not found"
(vcat [callStackDoc, ppr id,
text "local binds for:",
pprUFM local_binds $ \infos ->
vcat [ ppr (cg_id info) | info <- infos ]
])
------------------------------------------------------------------------
-- Interface functions for binding and re-binding names
------------------------------------------------------------------------
bindToReg :: NonVoid Id -> LambdaFormInfo -> FCode LocalReg
-- Bind an Id to a fresh LocalReg
bindToReg nvid@(NonVoid id) lf_info
= do platform <- getPlatform
let reg = idToReg platform nvid
addBindC (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)))
return reg
bindArgToGivenReg :: NonVoid Id -> LocalReg -> FCode ()
-- Records that an arg is already present in the given reg
bindArgToGivenReg (NonVoid id) reg
= do let !lf_info = mkLFArgument id
addBindC (mkCgIdInfo id lf_info (CmmReg (CmmLocal reg)))
rebindToReg :: NonVoid Id -> FCode LocalReg
-- Like bindToReg, but the Id is already in scope, so
-- get its LF info from the envt
rebindToReg nvid@(NonVoid id)
= do { info <- getCgIdInfo id
; bindToReg nvid (cg_lf info) }
bindArgToReg :: NonVoid Id -> FCode LocalReg
bindArgToReg nvid@(NonVoid id) = bindToReg nvid (mkLFArgument id)
bindArgsToRegs :: [NonVoid Id] -> FCode [LocalReg]
bindArgsToRegs = mapM bindArgToReg
idToReg :: Platform -> NonVoid Id -> LocalReg
-- Make a register from an Id, typically a function argument,
-- free variable, or case binder
--
-- We re-use the Unique from the Id to make it easier to see what is going on
--
-- By now the Ids should be uniquely named; else one would worry
-- about accidental collision
idToReg platform (NonVoid id)
= LocalReg (idUnique id)
(primRepCmmType platform (idPrimRep id))
|
