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
34 import CgUsages ( getHpRelOffset, getSpARelOffset, getSpBRelOffset )
35 import CLabel ( mkStaticClosureLabel, mkClosureLabel )
36 import ClosureInfo ( mkLFImported, mkConLFInfo, mkLFArgument, LambdaFormInfo )
37 import HeapOffs ( SYN_IE(VirtualHeapOffset),
38 SYN_IE(VirtualSpAOffset), SYN_IE(VirtualSpBOffset)
40 import Id ( idPrimRep, toplevelishId,
41 mkIdEnv, rngIdEnv, SYN_IE(IdEnv),
43 GenId{-instance NamedThing-}, SYN_IE(Id)
45 import Literal ( Literal )
46 import Maybes ( catMaybes )
47 import Name ( isLocallyDefined, isWiredInName,
48 Name{-instance NamedThing-}, NamedThing(..) )
50 import PprAbsC ( pprAmode )
52 import Outputable ( PprStyle(..) )
54 import PrimRep ( PrimRep )
55 import StgSyn ( SYN_IE(StgArg), SYN_IE(StgLiveVars), GenStgArg(..) )
56 import Unique ( Unique )
57 import UniqFM ( Uniquable(..) )
58 import Util ( zipWithEqual, panic )
62 %************************************************************************
64 \subsection[Bindery-datatypes]{Data types}
66 %************************************************************************
68 @(CgBinding a b)@ is a type of finite maps from a to b.
70 The assumption used to be that @lookupCgBind@ must get exactly one
71 match. This is {\em completely wrong} in the case of compiling
72 letrecs (where knot-tying is used). An initial binding is fed in (and
73 never evaluated); eventually, a correct binding is put into the
74 environment. So there can be two bindings for a given name.
77 type CgBindings = IdEnv CgIdInfo
80 = MkCgIdInfo Id -- Id that this is the info for
89 | RegLoc MagicId -- in one of the magic registers
90 -- (probably {Int,Float,Char,etc}Reg
92 | VirHpLoc VirtualHeapOffset -- Hp+offset (address of closure)
94 | VirNodeLoc VirtualHeapOffset -- Cts of offset indirect from Node
99 | VirAStkLoc VirtualSpAOffset
100 | VirBStkLoc VirtualSpBOffset
102 | StableAmodeLoc CAddrMode
104 -- these are so StableLoc can be abstract:
106 maybeAStkLoc (VirAStkLoc offset) = Just offset
107 maybeAStkLoc _ = Nothing
109 maybeBStkLoc (VirBStkLoc offset) = Just offset
110 maybeBStkLoc _ = Nothing
113 %************************************************************************
115 \subsection[Bindery-idInfo]{Manipulating IdInfo}
117 %************************************************************************
120 stableAmodeIdInfo i amode lf_info = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc amode) lf_info
121 heapIdInfo i offset lf_info = MkCgIdInfo i (VirHpLoc offset) NoStableLoc lf_info
122 tempIdInfo i uniq lf_info = MkCgIdInfo i (TempVarLoc uniq) NoStableLoc lf_info
124 letNoEscapeIdInfo i spa spb lf_info
125 = MkCgIdInfo i NoVolatileLoc (StableAmodeLoc (CJoinPoint spa spb)) lf_info
127 newTempAmodeAndIdInfo :: Id -> LambdaFormInfo -> (CAddrMode, CgIdInfo)
129 newTempAmodeAndIdInfo name lf_info
130 = (temp_amode, temp_idinfo)
133 temp_amode = CTemp uniq (idPrimRep name)
134 temp_idinfo = tempIdInfo name uniq lf_info
136 idInfoToAmode :: PrimRep -> CgIdInfo -> FCode CAddrMode
137 idInfoToAmode kind (MkCgIdInfo _ vol stab _) = idInfoPiecesToAmode kind vol stab
139 idInfoPiecesToAmode :: PrimRep -> VolatileLoc -> StableLoc -> FCode CAddrMode
141 idInfoPiecesToAmode kind (TempVarLoc uniq) stable_loc = returnFC (CTemp uniq kind)
142 idInfoPiecesToAmode kind (RegLoc magic_id) stable_loc = returnFC (CReg magic_id)
144 idInfoPiecesToAmode kind NoVolatileLoc (LitLoc lit) = returnFC (CLit lit)
145 idInfoPiecesToAmode kind NoVolatileLoc (StableAmodeLoc amode) = returnFC amode
147 idInfoPiecesToAmode kind (VirNodeLoc nd_off) stable_loc
148 = returnFC (CVal (NodeRel nd_off) kind)
149 -- Virtual offsets from Node increase into the closures,
150 -- and so do Node-relative offsets (which we want in the CVal),
151 -- so there is no mucking about to do to the offset.
153 idInfoPiecesToAmode kind (VirHpLoc hp_off) stable_loc
154 = getHpRelOffset hp_off `thenFC` \ rel_hp ->
155 returnFC (CAddr rel_hp)
157 idInfoPiecesToAmode kind NoVolatileLoc (VirAStkLoc i)
158 = getSpARelOffset i `thenFC` \ rel_spA ->
159 returnFC (CVal rel_spA kind)
161 idInfoPiecesToAmode kind NoVolatileLoc (VirBStkLoc i)
162 = getSpBRelOffset i `thenFC` \ rel_spB ->
163 returnFC (CVal rel_spB kind)
166 idInfoPiecesToAmode kind NoVolatileLoc NoStableLoc = panic "idInfoPiecesToAmode: no loc"
170 %************************************************************************
172 \subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
174 %************************************************************************
176 We sometimes want to nuke all the volatile bindings; we must be sure
177 we don't leave any (NoVolatile, NoStable) binds around...
180 nukeVolatileBinds :: CgBindings -> CgBindings
181 nukeVolatileBinds binds
182 = mkIdEnv (foldr keep_if_stable [] (rngIdEnv binds))
184 keep_if_stable (MkCgIdInfo i _ NoStableLoc entry_info) acc = acc
185 keep_if_stable (MkCgIdInfo i _ stable_loc entry_info) acc
186 = (i, MkCgIdInfo i NoVolatileLoc stable_loc entry_info) : acc
190 %************************************************************************
192 \subsection[lookup-interface]{Interface functions to looking up bindings}
194 %************************************************************************
196 I {\em think} all looking-up is done through @getCAddrMode(s)@.
199 getCAddrModeAndInfo :: Id -> FCode (CAddrMode, LambdaFormInfo)
201 getCAddrModeAndInfo id
202 | not (isLocallyDefined name) || isWiredInName name
203 {- Why the "isWiredInName"?
204 Imagine you are compiling PrelBase.hs (a module that
205 supplies some of the wired-in values). What can
206 happen is that the compiler will inject calls to
207 (e.g.) GHCbase.unpackPS, where-ever it likes -- it
208 assumes those values are ubiquitously available.
209 The main point is: it may inject calls to them earlier
210 in GHCbase.hs than the actual definition...
212 = returnFC (global_amode, mkLFImported id)
214 | otherwise = -- *might* be a nested defn: in any case, it's something whose
215 -- definition we will know about...
216 lookupBindC id `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
217 idInfoPiecesToAmode kind volatile_loc stable_loc `thenFC` \ amode ->
218 returnFC (amode, lf_info)
221 global_amode = CLbl (mkClosureLabel id) kind
224 getCAddrMode :: Id -> FCode CAddrMode
226 = getCAddrModeAndInfo name `thenFC` \ (amode, _) ->
231 getCAddrModeIfVolatile :: Id -> FCode (Maybe CAddrMode)
232 getCAddrModeIfVolatile name
233 | toplevelishId name = returnFC Nothing
235 = lookupBindC name `thenFC` \ ~(MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
237 NoStableLoc -> -- Aha! So it is volatile!
238 idInfoPiecesToAmode (idPrimRep name) volatile_loc NoStableLoc `thenFC` \ amode ->
239 returnFC (Just amode)
241 a_stable_loc -> returnFC Nothing
244 @getVolatileRegs@ gets a set of live variables, and returns a list of
245 all registers on which these variables depend. These are the regs
246 which must be saved and restored across any C calls. If a variable is
247 both in a volatile location (depending on a register) {\em and} a
248 stable one (notably, on the stack), we modify the current bindings to
249 forget the volatile one.
252 getVolatileRegs :: StgLiveVars -> FCode [MagicId]
255 = mapFCs snaffle_it (idSetToList vars) `thenFC` \ stuff ->
256 returnFC (catMaybes stuff)
259 = lookupBindC var `thenFC` \ (MkCgIdInfo _ volatile_loc stable_loc lf_info) ->
261 -- commoned-up code...
263 = if not (isVolatileReg reg) then
264 -- Potentially dies across C calls
265 -- For now, that's everything; we leave
266 -- it to the save-macros to decide which
267 -- regs *really* need to be saved.
271 NoStableLoc -> returnFC (Just reg) -- got one!
273 -- has both volatile & stable locations;
274 -- force it to rely on the stable location
275 modifyBindC var nuke_vol_bind `thenC`
279 RegLoc reg -> consider_reg reg
280 VirHpLoc _ -> consider_reg Hp
281 VirNodeLoc _ -> consider_reg node
282 non_reg_loc -> returnFC Nothing
284 nuke_vol_bind (MkCgIdInfo i _ stable_loc lf_info)
285 = MkCgIdInfo i NoVolatileLoc stable_loc lf_info
289 getArgAmodes :: [StgArg] -> FCode [CAddrMode]
290 getArgAmodes [] = returnFC []
291 getArgAmodes (atom:atoms)
292 = getArgAmode atom `thenFC` \ amode ->
293 getArgAmodes atoms `thenFC` \ amodes ->
294 returnFC ( amode : amodes )
296 getArgAmode :: StgArg -> FCode CAddrMode
298 getArgAmode (StgConArg var)
299 {- Why does this case differ from StgVarArg?
300 Because the program might look like this:
301 data Foo a = Empty | Baz a
302 f a x = let c = Empty! a
304 Now, when we go Core->Stg, we drop the type applications,
305 so we can inline c, giving
307 Now we are referring to Empty as an argument (rather than in an STGCon),
308 so we'll look it up with getCAddrMode. We want to return an amode for
309 the static closure that we make for nullary constructors. But if we blindly
310 go ahead with getCAddrMode we end up looking in the environment, and it ain't there!
312 This special case used to be in getCAddrModeAndInfo, but it doesn't work there.
315 If the constructor Baz isn't inlined we simply want to treat it like any other
316 identifier, with a top level definition. We don't want to spot that it's a constructor.
322 are treated differently; the former is a call to a bog standard function while the
323 latter uses the specially-labelled, pre-defined info tables etc for the constructor.
325 The way to think of this case in getArgAmode is that
328 App f (StgCon Empty [])
330 = returnFC (CLbl (mkStaticClosureLabel var) (idPrimRep var))
332 getArgAmode (StgVarArg var) = getCAddrMode var -- The common case
334 getArgAmode (StgLitArg lit) = returnFC (CLit lit)
337 %************************************************************************
339 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
341 %************************************************************************
344 bindNewToAStack :: (Id, VirtualSpAOffset) -> Code
345 bindNewToAStack (name, offset)
348 info = MkCgIdInfo name NoVolatileLoc (VirAStkLoc offset) mkLFArgument
350 bindNewToBStack :: (Id, VirtualSpBOffset) -> Code
351 bindNewToBStack (name, offset)
354 info = MkCgIdInfo name NoVolatileLoc (VirBStkLoc offset) (panic "bindNewToBStack")
355 -- B-stack things shouldn't need lambda-form info!
357 bindNewToNode :: Id -> VirtualHeapOffset -> LambdaFormInfo -> Code
358 bindNewToNode name offset lf_info
361 info = MkCgIdInfo name (VirNodeLoc offset) NoStableLoc lf_info
363 -- Create a new temporary whose unique is that in the id,
364 -- bind the id to it, and return the addressing mode for the
366 bindNewToTemp :: Id -> FCode CAddrMode
368 = let (temp_amode, id_info) = newTempAmodeAndIdInfo name mkLFArgument
369 -- This is used only for things we don't know
370 -- anything about; values returned by a case statement,
373 addBindC name id_info `thenC`
376 bindNewToReg :: Id -> MagicId -> LambdaFormInfo -> Code
377 bindNewToReg name magic_id lf_info
380 info = MkCgIdInfo name (RegLoc magic_id) NoStableLoc lf_info
382 bindNewToLit name lit
385 info = MkCgIdInfo name NoVolatileLoc (LitLoc lit) (error "bindNewToLit")
387 bindArgsToRegs :: [Id] -> [MagicId] -> Code
388 bindArgsToRegs args regs
389 = listCs (zipWithEqual "bindArgsToRegs" bind args regs)
391 arg `bind` reg = bindNewToReg arg reg mkLFArgument
394 @bindNewPrimToAmode@ works only for certain addressing modes, because
395 those are the only ones we've needed so far!
398 bindNewPrimToAmode :: Id -> CAddrMode -> Code
399 bindNewPrimToAmode name (CReg reg) = bindNewToReg name reg (panic "bindNewPrimToAmode")
401 -- LFinfo is irrelevant for primitives
402 bindNewPrimToAmode name (CTemp uniq kind)
403 = addBindC name (tempIdInfo name uniq (panic "bindNewPrimToAmode"))
404 -- LFinfo is irrelevant for primitives
406 bindNewPrimToAmode name (CLit lit) = bindNewToLit name lit
408 bindNewPrimToAmode name (CVal (SpBRel _ offset) _)
409 = bindNewToBStack (name, offset)
411 bindNewPrimToAmode name (CVal (NodeRel offset) _)
412 = bindNewToNode name offset (panic "bindNewPrimToAmode node")
413 -- See comment on idInfoPiecesToAmode for VirNodeLoc
416 bindNewPrimToAmode name amode
417 = panic ("bindNew...:"++(show (pprAmode PprDebug amode)))
422 rebindToAStack :: Id -> VirtualSpAOffset -> Code
423 rebindToAStack name offset
424 = modifyBindC name replace_stable_fn
426 replace_stable_fn (MkCgIdInfo i vol stab einfo)
427 = MkCgIdInfo i vol (VirAStkLoc offset) einfo
429 rebindToBStack :: Id -> VirtualSpBOffset -> Code
430 rebindToBStack name offset
431 = modifyBindC name replace_stable_fn
433 replace_stable_fn (MkCgIdInfo i vol stab einfo)
434 = MkCgIdInfo i vol (VirBStkLoc offset) einfo