2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[CgBindery]{Utility functions related to doing @CgBindings@}
8 CgBindings, CgIdInfo(..){-dubiously concrete-},
9 StableLoc, VolatileLoc,
11 maybeAStkLoc, maybeBStkLoc,
13 stableAmodeIdInfo, heapIdInfo, newTempAmodeAndIdInfo,
14 letNoEscapeIdInfo, idInfoToAmode,
18 bindNewToAStack, bindNewToBStack,
19 bindNewToNode, bindNewToReg, bindArgsToRegs,
20 bindNewToTemp, bindNewPrimToAmode,
21 getArgAmode, getArgAmodes,
22 getCAddrModeAndInfo, getCAddrMode,
23 getCAddrModeIfVolatile, getVolatileRegs,
24 rebindToAStack, rebindToBStack
27 #include "HsVersions.h"
32 import CgUsages ( getHpRelOffset, getSpARelOffset, getSpBRelOffset )
33 import CLabel ( mkStaticClosureLabel, mkClosureLabel )
34 import ClosureInfo ( mkLFImported, mkConLFInfo, mkLFArgument, LambdaFormInfo )
35 import HeapOffs ( VirtualHeapOffset,
36 VirtualSpAOffset, VirtualSpBOffset
38 import Id ( idPrimRep, toplevelishId,
39 mkIdEnv, rngIdEnv, IdEnv,
43 import Literal ( Literal )
44 import Maybes ( catMaybes )
45 import Name ( isLocallyDefined, isWiredInName,
46 Name{-instance NamedThing-}, NamedThing(..) )
47 import PprAbsC ( pprAmode )
48 import PrimRep ( PrimRep )
49 import StgSyn ( StgArg, StgLiveVars, GenStgArg(..) )
50 import Unique ( Unique, Uniquable(..) )
51 import Util ( zipWithEqual, panic )
56 %************************************************************************
58 \subsection[Bindery-datatypes]{Data types}
60 %************************************************************************
62 @(CgBinding a b)@ is a type of finite maps from a to b.
64 The assumption used to be that @lookupCgBind@ must get exactly one
65 match. This is {\em completely wrong} in the case of compiling
66 letrecs (where knot-tying is used). An initial binding is fed in (and
67 never evaluated); eventually, a correct binding is put into the
68 environment. So there can be two bindings for a given name.
71 type CgBindings = IdEnv CgIdInfo
74 = MkCgIdInfo Id -- Id that this is the info for
83 | RegLoc MagicId -- in one of the magic registers
84 -- (probably {Int,Float,Char,etc}Reg
86 | VirHpLoc VirtualHeapOffset -- Hp+offset (address of closure)
88 | VirNodeLoc VirtualHeapOffset -- Cts of offset indirect from Node
92 @StableLoc@ encodes where an Id can be found, used by
93 the @CgBindings@ environment in @CgBindery@.
98 | VirAStkLoc VirtualSpAOffset
99 | VirBStkLoc VirtualSpBOffset
101 | StableAmodeLoc CAddrMode
103 -- these are so StableLoc can be abstract:
105 maybeAStkLoc (VirAStkLoc offset) = Just offset
106 maybeAStkLoc _ = Nothing
108 maybeBStkLoc (VirBStkLoc offset) = Just offset
109 maybeBStkLoc _ = Nothing
112 %************************************************************************
114 \subsection[Bindery-idInfo]{Manipulating IdInfo}
116 %************************************************************************
119 stableAmodeIdInfo i amode lf_info = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc amode) lf_info
120 heapIdInfo i offset lf_info = MkCgIdInfo i (VirHpLoc offset) NoStableLoc lf_info
121 tempIdInfo i uniq lf_info = MkCgIdInfo i (TempVarLoc uniq) NoStableLoc lf_info
123 letNoEscapeIdInfo i spa spb lf_info
124 = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc (CJoinPoint spa spb)) lf_info
126 newTempAmodeAndIdInfo :: Id -> LambdaFormInfo -> (CAddrMode, CgIdInfo)
128 newTempAmodeAndIdInfo name lf_info
129 = (temp_amode, temp_idinfo)
132 temp_amode = CTemp uniq (idPrimRep name)
133 temp_idinfo = tempIdInfo name uniq lf_info
135 idInfoToAmode :: PrimRep -> CgIdInfo -> FCode CAddrMode
136 idInfoToAmode kind (MkCgIdInfo _ vol stab _) = idInfoPiecesToAmode kind vol stab
138 idInfoPiecesToAmode :: PrimRep -> VolatileLoc -> StableLoc -> FCode CAddrMode
140 idInfoPiecesToAmode kind (TempVarLoc uniq) stable_loc = returnFC (CTemp uniq kind)
141 idInfoPiecesToAmode kind (RegLoc magic_id) stable_loc = returnFC (CReg magic_id)
143 idInfoPiecesToAmode kind NoVolatileLoc (LitLoc lit) = returnFC (CLit lit)
144 idInfoPiecesToAmode kind NoVolatileLoc (StableAmodeLoc amode) = returnFC amode
146 idInfoPiecesToAmode kind (VirNodeLoc nd_off) stable_loc
147 = returnFC (CVal (NodeRel nd_off) kind)
148 -- Virtual offsets from Node increase into the closures,
149 -- and so do Node-relative offsets (which we want in the CVal),
150 -- so there is no mucking about to do to the offset.
152 idInfoPiecesToAmode kind (VirHpLoc hp_off) stable_loc
153 = getHpRelOffset hp_off `thenFC` \ rel_hp ->
154 returnFC (CAddr rel_hp)
156 idInfoPiecesToAmode kind NoVolatileLoc (VirAStkLoc i)
157 = getSpARelOffset i `thenFC` \ rel_spA ->
158 returnFC (CVal rel_spA kind)
160 idInfoPiecesToAmode kind NoVolatileLoc (VirBStkLoc i)
161 = getSpBRelOffset i `thenFC` \ rel_spB ->
162 returnFC (CVal rel_spB kind)
165 idInfoPiecesToAmode kind NoVolatileLoc NoStableLoc = panic "idInfoPiecesToAmode: no loc"
169 %************************************************************************
171 \subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
173 %************************************************************************
175 We sometimes want to nuke all the volatile bindings; we must be sure
176 we don't leave any (NoVolatile, NoStable) binds around...
179 nukeVolatileBinds :: CgBindings -> CgBindings
180 nukeVolatileBinds binds
181 = mkIdEnv (foldr keep_if_stable [] (rngIdEnv binds))
183 keep_if_stable (MkCgIdInfo i _ NoStableLoc entry_info) acc = acc
184 keep_if_stable (MkCgIdInfo i _ stable_loc entry_info) acc
185 = (i, MkCgIdInfo i NoVolatileLoc stable_loc entry_info) : acc
189 %************************************************************************
191 \subsection[lookup-interface]{Interface functions to looking up bindings}
193 %************************************************************************
195 I {\em think} all looking-up is done through @getCAddrMode(s)@.
198 getCAddrModeAndInfo :: Id -> FCode (CAddrMode, LambdaFormInfo)
200 getCAddrModeAndInfo id
201 | not (isLocallyDefined name) || isWiredInName name
202 {- Why the "isWiredInName"?
203 Imagine you are compiling PrelBase.hs (a module that
204 supplies some of the wired-in values). What can
205 happen is that the compiler will inject calls to
206 (e.g.) GHCbase.unpackPS, where-ever it likes -- it
207 assumes those values are ubiquitously available.
208 The main point is: it may inject calls to them earlier
209 in GHCbase.hs than the actual definition...
211 = returnFC (global_amode, mkLFImported id)
213 | otherwise = -- *might* be a nested defn: in any case, it's something whose
214 -- definition we will know about...
215 lookupBindC id `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
216 idInfoPiecesToAmode kind volatile_loc stable_loc `thenFC` \ amode ->
217 returnFC (amode, lf_info)
220 global_amode = CLbl (mkClosureLabel id) kind
223 getCAddrMode :: Id -> FCode CAddrMode
225 = getCAddrModeAndInfo name `thenFC` \ (amode, _) ->
230 getCAddrModeIfVolatile :: Id -> FCode (Maybe CAddrMode)
231 getCAddrModeIfVolatile name
232 | toplevelishId name = returnFC Nothing
234 = lookupBindC name `thenFC` \ ~(MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
236 NoStableLoc -> -- Aha! So it is volatile!
237 idInfoPiecesToAmode (idPrimRep name) volatile_loc NoStableLoc `thenFC` \ amode ->
238 returnFC (Just amode)
240 a_stable_loc -> returnFC Nothing
243 @getVolatileRegs@ gets a set of live variables, and returns a list of
244 all registers on which these variables depend. These are the regs
245 which must be saved and restored across any C calls. If a variable is
246 both in a volatile location (depending on a register) {\em and} a
247 stable one (notably, on the stack), we modify the current bindings to
248 forget the volatile one.
251 getVolatileRegs :: StgLiveVars -> FCode [MagicId]
254 = mapFCs snaffle_it (idSetToList vars) `thenFC` \ stuff ->
255 returnFC (catMaybes stuff)
258 = lookupBindC var `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
260 -- commoned-up code...
262 = if not (isVolatileReg reg) then
263 -- Potentially dies across C calls
264 -- For now, that's everything; we leave
265 -- it to the save-macros to decide which
266 -- regs *really* need to be saved.
270 NoStableLoc -> returnFC (Just reg) -- got one!
272 -- has both volatile & stable locations;
273 -- force it to rely on the stable location
274 modifyBindC var nuke_vol_bind `thenC`
278 RegLoc reg -> consider_reg reg
279 VirHpLoc _ -> consider_reg Hp
280 VirNodeLoc _ -> consider_reg node
281 non_reg_loc -> returnFC Nothing
283 nuke_vol_bind (MkCgIdInfo i _ stable_loc lf_info)
284 = MkCgIdInfo i NoVolatileLoc stable_loc lf_info
288 getArgAmodes :: [StgArg] -> FCode [CAddrMode]
289 getArgAmodes [] = returnFC []
290 getArgAmodes (atom:atoms)
291 = getArgAmode atom `thenFC` \ amode ->
292 getArgAmodes atoms `thenFC` \ amodes ->
293 returnFC ( amode : amodes )
295 getArgAmode :: StgArg -> FCode CAddrMode
297 getArgAmode (StgConArg var)
298 {- Why does this case differ from StgVarArg?
299 Because the program might look like this:
300 data Foo a = Empty | Baz a
301 f a x = let c = Empty! a
303 Now, when we go Core->Stg, we drop the type applications,
304 so we can inline c, giving
306 Now we are referring to Empty as an argument (rather than in an STGCon),
307 so we'll look it up with getCAddrMode. We want to return an amode for
308 the static closure that we make for nullary constructors. But if we blindly
309 go ahead with getCAddrMode we end up looking in the environment, and it ain't there!
311 This special case used to be in getCAddrModeAndInfo, but it doesn't work there.
314 If the constructor Baz isn't inlined we simply want to treat it like any other
315 identifier, with a top level definition. We don't want to spot that it's a constructor.
321 are treated differently; the former is a call to a bog standard function while the
322 latter uses the specially-labelled, pre-defined info tables etc for the constructor.
324 The way to think of this case in getArgAmode is that
327 App f (StgCon Empty [])
329 = returnFC (CLbl (mkStaticClosureLabel var) (idPrimRep var))
331 getArgAmode (StgVarArg var) = getCAddrMode var -- The common case
333 getArgAmode (StgLitArg lit) = returnFC (CLit lit)
336 %************************************************************************
338 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
340 %************************************************************************
343 bindNewToAStack :: (Id, VirtualSpAOffset) -> Code
344 bindNewToAStack (name, offset)
347 info = MkCgIdInfo name NoVolatileLoc (VirAStkLoc offset) mkLFArgument
349 bindNewToBStack :: (Id, VirtualSpBOffset) -> Code
350 bindNewToBStack (name, offset)
353 info = MkCgIdInfo name NoVolatileLoc (VirBStkLoc offset) (panic "bindNewToBStack")
354 -- B-stack things shouldn't need lambda-form info!
356 bindNewToNode :: Id -> VirtualHeapOffset -> LambdaFormInfo -> Code
357 bindNewToNode name offset lf_info
360 info = MkCgIdInfo name (VirNodeLoc offset) NoStableLoc lf_info
362 -- Create a new temporary whose unique is that in the id,
363 -- bind the id to it, and return the addressing mode for the
365 bindNewToTemp :: Id -> FCode CAddrMode
367 = let (temp_amode, id_info) = newTempAmodeAndIdInfo name mkLFArgument
368 -- This is used only for things we don't know
369 -- anything about; values returned by a case statement,
372 addBindC name id_info `thenC`
375 bindNewToReg :: Id -> MagicId -> LambdaFormInfo -> Code
376 bindNewToReg name magic_id lf_info
379 info = MkCgIdInfo name (RegLoc magic_id) NoStableLoc lf_info
381 bindNewToLit name lit
384 info = MkCgIdInfo name NoVolatileLoc (LitLoc lit) (error "bindNewToLit")
386 bindArgsToRegs :: [Id] -> [MagicId] -> Code
387 bindArgsToRegs args regs
388 = listCs (zipWithEqual "bindArgsToRegs" bind args regs)
390 arg `bind` reg = bindNewToReg arg reg mkLFArgument
393 @bindNewPrimToAmode@ works only for certain addressing modes, because
394 those are the only ones we've needed so far!
397 bindNewPrimToAmode :: Id -> CAddrMode -> Code
398 bindNewPrimToAmode name (CReg reg) = bindNewToReg name reg (panic "bindNewPrimToAmode")
400 -- LFinfo is irrelevant for primitives
401 bindNewPrimToAmode name (CTemp uniq kind)
402 = addBindC name (tempIdInfo name uniq (panic "bindNewPrimToAmode"))
403 -- LFinfo is irrelevant for primitives
405 bindNewPrimToAmode name (CLit lit) = bindNewToLit name lit
407 bindNewPrimToAmode name (CVal (SpBRel _ offset) _)
408 = bindNewToBStack (name, offset)
410 bindNewPrimToAmode name (CVal (NodeRel offset) _)
411 = bindNewToNode name offset (panic "bindNewPrimToAmode node")
412 -- See comment on idInfoPiecesToAmode for VirNodeLoc
415 bindNewPrimToAmode name amode
416 = pprPanic "bindNew...:" (pprAmode amode)
421 rebindToAStack :: Id -> VirtualSpAOffset -> Code
422 rebindToAStack name offset
423 = modifyBindC name replace_stable_fn
425 replace_stable_fn (MkCgIdInfo i vol stab einfo)
426 = MkCgIdInfo i vol (VirAStkLoc offset) einfo
428 rebindToBStack :: Id -> VirtualSpBOffset -> Code
429 rebindToBStack name offset
430 = modifyBindC name replace_stable_fn
432 replace_stable_fn (MkCgIdInfo i vol stab einfo)
433 = MkCgIdInfo i vol (VirBStkLoc offset) einfo