2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[CgBindery]{Utility functions related to doing @CgBindings@}
7 #include "HsVersions.h"
10 SYN_IE(CgBindings), CgIdInfo(..){-dubiously concrete-},
11 StableLoc, VolatileLoc,
13 maybeAStkLoc, maybeBStkLoc,
15 stableAmodeIdInfo, heapIdInfo, newTempAmodeAndIdInfo,
16 letNoEscapeIdInfo, idInfoToAmode,
20 bindNewToAStack, bindNewToBStack,
21 bindNewToNode, bindNewToReg, bindArgsToRegs,
22 bindNewToTemp, bindNewPrimToAmode,
23 getArgAmode, getArgAmodes,
24 getCAddrModeAndInfo, getCAddrMode,
25 getCAddrModeIfVolatile, getVolatileRegs,
26 rebindToAStack, rebindToBStack
30 --IMPORT_DELOOPER(CgLoop1) -- here for paranoia-checking
35 import CgUsages ( getHpRelOffset, getSpARelOffset, getSpBRelOffset )
36 import CLabel ( mkStaticClosureLabel, mkClosureLabel )
37 import ClosureInfo ( mkLFImported, mkConLFInfo, mkLFArgument, LambdaFormInfo )
38 import HeapOffs ( SYN_IE(VirtualHeapOffset),
39 SYN_IE(VirtualSpAOffset), SYN_IE(VirtualSpBOffset)
41 import Id ( idPrimRep, toplevelishId,
42 mkIdEnv, rngIdEnv, SYN_IE(IdEnv),
44 GenId{-instance NamedThing-}, SYN_IE(Id)
46 import Literal ( Literal )
47 import Maybes ( catMaybes )
48 import Name ( isLocallyDefined, isWiredInName,
49 Name{-instance NamedThing-}, NamedThing(..) )
51 import PprAbsC ( pprAmode )
53 import Outputable ( PprStyle(..) )
55 import PrimRep ( PrimRep )
56 import StgSyn ( SYN_IE(StgArg), SYN_IE(StgLiveVars), GenStgArg(..) )
57 import Unique ( Unique )
58 import UniqFM ( Uniquable(..) )
59 import Util ( zipWithEqual, panic )
63 %************************************************************************
65 \subsection[Bindery-datatypes]{Data types}
67 %************************************************************************
69 @(CgBinding a b)@ is a type of finite maps from a to b.
71 The assumption used to be that @lookupCgBind@ must get exactly one
72 match. This is {\em completely wrong} in the case of compiling
73 letrecs (where knot-tying is used). An initial binding is fed in (and
74 never evaluated); eventually, a correct binding is put into the
75 environment. So there can be two bindings for a given name.
78 type CgBindings = IdEnv CgIdInfo
81 = MkCgIdInfo Id -- Id that this is the info for
90 | RegLoc MagicId -- in one of the magic registers
91 -- (probably {Int,Float,Char,etc}Reg
93 | VirHpLoc VirtualHeapOffset -- Hp+offset (address of closure)
95 | VirNodeLoc VirtualHeapOffset -- Cts of offset indirect from Node
100 | VirAStkLoc VirtualSpAOffset
101 | VirBStkLoc VirtualSpBOffset
103 | StableAmodeLoc CAddrMode
105 -- these are so StableLoc can be abstract:
107 maybeAStkLoc (VirAStkLoc offset) = Just offset
108 maybeAStkLoc _ = Nothing
110 maybeBStkLoc (VirBStkLoc offset) = Just offset
111 maybeBStkLoc _ = Nothing
114 %************************************************************************
116 \subsection[Bindery-idInfo]{Manipulating IdInfo}
118 %************************************************************************
121 stableAmodeIdInfo i amode lf_info = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc amode) lf_info
122 heapIdInfo i offset lf_info = MkCgIdInfo i (VirHpLoc offset) NoStableLoc lf_info
123 tempIdInfo i uniq lf_info = MkCgIdInfo i (TempVarLoc uniq) NoStableLoc lf_info
125 letNoEscapeIdInfo i spa spb lf_info
126 = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc (CJoinPoint spa spb)) lf_info
128 newTempAmodeAndIdInfo :: Id -> LambdaFormInfo -> (CAddrMode, CgIdInfo)
130 newTempAmodeAndIdInfo name lf_info
131 = (temp_amode, temp_idinfo)
134 temp_amode = CTemp uniq (idPrimRep name)
135 temp_idinfo = tempIdInfo name uniq lf_info
137 idInfoToAmode :: PrimRep -> CgIdInfo -> FCode CAddrMode
138 idInfoToAmode kind (MkCgIdInfo _ vol stab _) = idInfoPiecesToAmode kind vol stab
140 idInfoPiecesToAmode :: PrimRep -> VolatileLoc -> StableLoc -> FCode CAddrMode
142 idInfoPiecesToAmode kind (TempVarLoc uniq) stable_loc = returnFC (CTemp uniq kind)
143 idInfoPiecesToAmode kind (RegLoc magic_id) stable_loc = returnFC (CReg magic_id)
145 idInfoPiecesToAmode kind NoVolatileLoc (LitLoc lit) = returnFC (CLit lit)
146 idInfoPiecesToAmode kind NoVolatileLoc (StableAmodeLoc amode) = returnFC amode
148 idInfoPiecesToAmode kind (VirNodeLoc nd_off) stable_loc
149 = returnFC (CVal (NodeRel nd_off) kind)
150 -- Virtual offsets from Node increase into the closures,
151 -- and so do Node-relative offsets (which we want in the CVal),
152 -- so there is no mucking about to do to the offset.
154 idInfoPiecesToAmode kind (VirHpLoc hp_off) stable_loc
155 = getHpRelOffset hp_off `thenFC` \ rel_hp ->
156 returnFC (CAddr rel_hp)
158 idInfoPiecesToAmode kind NoVolatileLoc (VirAStkLoc i)
159 = getSpARelOffset i `thenFC` \ rel_spA ->
160 returnFC (CVal rel_spA kind)
162 idInfoPiecesToAmode kind NoVolatileLoc (VirBStkLoc i)
163 = getSpBRelOffset i `thenFC` \ rel_spB ->
164 returnFC (CVal rel_spB kind)
167 idInfoPiecesToAmode kind NoVolatileLoc NoStableLoc = panic "idInfoPiecesToAmode: no loc"
171 %************************************************************************
173 \subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
175 %************************************************************************
177 We sometimes want to nuke all the volatile bindings; we must be sure
178 we don't leave any (NoVolatile, NoStable) binds around...
181 nukeVolatileBinds :: CgBindings -> CgBindings
182 nukeVolatileBinds binds
183 = mkIdEnv (foldr keep_if_stable [] (rngIdEnv binds))
185 keep_if_stable (MkCgIdInfo i _ NoStableLoc entry_info) acc = acc
186 keep_if_stable (MkCgIdInfo i _ stable_loc entry_info) acc
187 = (i, MkCgIdInfo i NoVolatileLoc stable_loc entry_info) : acc
191 %************************************************************************
193 \subsection[lookup-interface]{Interface functions to looking up bindings}
195 %************************************************************************
197 I {\em think} all looking-up is done through @getCAddrMode(s)@.
200 getCAddrModeAndInfo :: Id -> FCode (CAddrMode, LambdaFormInfo)
202 getCAddrModeAndInfo id
203 | not (isLocallyDefined name) || isWiredInName name
204 {- Why the "isWiredInName"?
205 Imagine you are compiling PrelBase.hs (a module that
206 supplies some of the wired-in values). What can
207 happen is that the compiler will inject calls to
208 (e.g.) GHCbase.unpackPS, where-ever it likes -- it
209 assumes those values are ubiquitously available.
210 The main point is: it may inject calls to them earlier
211 in GHCbase.hs than the actual definition...
213 = returnFC (global_amode, mkLFImported id)
215 | otherwise = -- *might* be a nested defn: in any case, it's something whose
216 -- definition we will know about...
217 lookupBindC id `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
218 idInfoPiecesToAmode kind volatile_loc stable_loc `thenFC` \ amode ->
219 returnFC (amode, lf_info)
222 global_amode = CLbl (mkClosureLabel id) kind
225 getCAddrMode :: Id -> FCode CAddrMode
227 = getCAddrModeAndInfo name `thenFC` \ (amode, _) ->
232 getCAddrModeIfVolatile :: Id -> FCode (Maybe CAddrMode)
233 getCAddrModeIfVolatile name
234 | toplevelishId name = returnFC Nothing
236 = lookupBindC name `thenFC` \ ~(MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
238 NoStableLoc -> -- Aha! So it is volatile!
239 idInfoPiecesToAmode (idPrimRep name) volatile_loc NoStableLoc `thenFC` \ amode ->
240 returnFC (Just amode)
242 a_stable_loc -> returnFC Nothing
245 @getVolatileRegs@ gets a set of live variables, and returns a list of
246 all registers on which these variables depend. These are the regs
247 which must be saved and restored across any C calls. If a variable is
248 both in a volatile location (depending on a register) {\em and} a
249 stable one (notably, on the stack), we modify the current bindings to
250 forget the volatile one.
253 getVolatileRegs :: StgLiveVars -> FCode [MagicId]
256 = mapFCs snaffle_it (idSetToList vars) `thenFC` \ stuff ->
257 returnFC (catMaybes stuff)
260 = lookupBindC var `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
262 -- commoned-up code...
264 = if not (isVolatileReg reg) then
265 -- Potentially dies across C calls
266 -- For now, that's everything; we leave
267 -- it to the save-macros to decide which
268 -- regs *really* need to be saved.
272 NoStableLoc -> returnFC (Just reg) -- got one!
274 -- has both volatile & stable locations;
275 -- force it to rely on the stable location
276 modifyBindC var nuke_vol_bind `thenC`
280 RegLoc reg -> consider_reg reg
281 VirHpLoc _ -> consider_reg Hp
282 VirNodeLoc _ -> consider_reg node
283 non_reg_loc -> returnFC Nothing
285 nuke_vol_bind (MkCgIdInfo i _ stable_loc lf_info)
286 = MkCgIdInfo i NoVolatileLoc stable_loc lf_info
290 getArgAmodes :: [StgArg] -> FCode [CAddrMode]
291 getArgAmodes [] = returnFC []
292 getArgAmodes (atom:atoms)
293 = getArgAmode atom `thenFC` \ amode ->
294 getArgAmodes atoms `thenFC` \ amodes ->
295 returnFC ( amode : amodes )
297 getArgAmode :: StgArg -> FCode CAddrMode
299 getArgAmode (StgConArg var)
300 {- Why does this case differ from StgVarArg?
301 Because the program might look like this:
302 data Foo a = Empty | Baz a
303 f a x = let c = Empty! a
305 Now, when we go Core->Stg, we drop the type applications,
306 so we can inline c, giving
308 Now we are referring to Empty as an argument (rather than in an STGCon),
309 so we'll look it up with getCAddrMode. We want to return an amode for
310 the static closure that we make for nullary constructors. But if we blindly
311 go ahead with getCAddrMode we end up looking in the environment, and it ain't there!
313 This special case used to be in getCAddrModeAndInfo, but it doesn't work there.
316 If the constructor Baz isn't inlined we simply want to treat it like any other
317 identifier, with a top level definition. We don't want to spot that it's a constructor.
323 are treated differently; the former is a call to a bog standard function while the
324 latter uses the specially-labelled, pre-defined info tables etc for the constructor.
326 The way to think of this case in getArgAmode is that
329 App f (StgCon Empty [])
331 = returnFC (CLbl (mkStaticClosureLabel var) (idPrimRep var))
333 getArgAmode (StgVarArg var) = getCAddrMode var -- The common case
335 getArgAmode (StgLitArg lit) = returnFC (CLit lit)
338 %************************************************************************
340 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
342 %************************************************************************
345 bindNewToAStack :: (Id, VirtualSpAOffset) -> Code
346 bindNewToAStack (name, offset)
349 info = MkCgIdInfo name NoVolatileLoc (VirAStkLoc offset) mkLFArgument
351 bindNewToBStack :: (Id, VirtualSpBOffset) -> Code
352 bindNewToBStack (name, offset)
355 info = MkCgIdInfo name NoVolatileLoc (VirBStkLoc offset) (panic "bindNewToBStack")
356 -- B-stack things shouldn't need lambda-form info!
358 bindNewToNode :: Id -> VirtualHeapOffset -> LambdaFormInfo -> Code
359 bindNewToNode name offset lf_info
362 info = MkCgIdInfo name (VirNodeLoc offset) NoStableLoc lf_info
364 -- Create a new temporary whose unique is that in the id,
365 -- bind the id to it, and return the addressing mode for the
367 bindNewToTemp :: Id -> FCode CAddrMode
369 = let (temp_amode, id_info) = newTempAmodeAndIdInfo name mkLFArgument
370 -- This is used only for things we don't know
371 -- anything about; values returned by a case statement,
374 addBindC name id_info `thenC`
377 bindNewToReg :: Id -> MagicId -> LambdaFormInfo -> Code
378 bindNewToReg name magic_id lf_info
381 info = MkCgIdInfo name (RegLoc magic_id) NoStableLoc lf_info
383 bindNewToLit name lit
386 info = MkCgIdInfo name NoVolatileLoc (LitLoc lit) (error "bindNewToLit")
388 bindArgsToRegs :: [Id] -> [MagicId] -> Code
389 bindArgsToRegs args regs
390 = listCs (zipWithEqual "bindArgsToRegs" bind args regs)
392 arg `bind` reg = bindNewToReg arg reg mkLFArgument
395 @bindNewPrimToAmode@ works only for certain addressing modes, because
396 those are the only ones we've needed so far!
399 bindNewPrimToAmode :: Id -> CAddrMode -> Code
400 bindNewPrimToAmode name (CReg reg) = bindNewToReg name reg (panic "bindNewPrimToAmode")
402 -- LFinfo is irrelevant for primitives
403 bindNewPrimToAmode name (CTemp uniq kind)
404 = addBindC name (tempIdInfo name uniq (panic "bindNewPrimToAmode"))
405 -- LFinfo is irrelevant for primitives
407 bindNewPrimToAmode name (CLit lit) = bindNewToLit name lit
409 bindNewPrimToAmode name (CVal (SpBRel _ offset) _)
410 = bindNewToBStack (name, offset)
412 bindNewPrimToAmode name (CVal (NodeRel offset) _)
413 = bindNewToNode name offset (panic "bindNewPrimToAmode node")
414 -- See comment on idInfoPiecesToAmode for VirNodeLoc
417 bindNewPrimToAmode name amode
418 = panic ("bindNew...:"++(show (pprAmode PprDebug amode)))
423 rebindToAStack :: Id -> VirtualSpAOffset -> Code
424 rebindToAStack name offset
425 = modifyBindC name replace_stable_fn
427 replace_stable_fn (MkCgIdInfo i vol stab einfo)
428 = MkCgIdInfo i vol (VirAStkLoc offset) einfo
430 rebindToBStack :: Id -> VirtualSpBOffset -> Code
431 rebindToBStack name offset
432 = modifyBindC name replace_stable_fn
434 replace_stable_fn (MkCgIdInfo i vol stab einfo)
435 = MkCgIdInfo i vol (VirBStkLoc offset) einfo