2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[CgBindery]{Utility functions related to doing @CgBindings@}
9 StableLoc, VolatileLoc,
11 cgIdInfoId, cgIdInfoArgRep, cgIdInfoLF,
13 stableIdInfo, heapIdInfo,
14 letNoEscapeIdInfo, idInfoToAmode,
22 bindArgsToStack, rebindToStack,
23 bindNewToNode, bindNewToReg, bindArgsToRegs,
25 getArgAmode, getArgAmodes,
27 getCAddrModeIfVolatile, getVolatileRegs,
31 #include "HsVersions.h"
34 import CgHeapery ( getHpRelOffset )
35 import CgStackery ( freeStackSlots, getSpRelOffset )
36 import CgUtils ( cgLit, cmmOffsetW )
37 import CLabel ( mkClosureLabel, pprCLabel )
38 import ClosureInfo ( mkLFImported, mkLFArgument, LambdaFormInfo )
41 import PprCmm ( {- instance Outputable -} )
42 import SMRep ( CgRep(..), WordOff, isFollowableArg,
43 isVoidArg, cgRepSizeW, argMachRep,
45 import Id ( Id, idName )
47 import VarSet ( varSetElems )
48 import Literal ( literalType )
49 import Maybes ( catMaybes )
50 import Name ( isExternalName )
51 import StgSyn ( StgArg, StgLiveVars, GenStgArg(..), isStgTypeArg )
52 import Unique ( Uniquable(..) )
53 import UniqSet ( elementOfUniqSet )
58 %************************************************************************
60 \subsection[Bindery-datatypes]{Data types}
62 %************************************************************************
64 @(CgBinding a b)@ is a type of finite maps from a to b.
66 The assumption used to be that @lookupCgBind@ must get exactly one
67 match. This is {\em completely wrong} in the case of compiling
68 letrecs (where knot-tying is used). An initial binding is fed in (and
69 never evaluated); eventually, a correct binding is put into the
70 environment. So there can be two bindings for a given name.
73 type CgBindings = IdEnv CgIdInfo
77 { cg_id :: Id -- Id that this is the info for
78 -- Can differ from the Id at occurrence sites by
79 -- virtue of being externalised, for splittable C
81 , cg_vol :: VolatileLoc
83 , cg_lf :: LambdaFormInfo }
85 mkCgIdInfo id vol stb lf
86 = CgIdInfo { cg_id = id, cg_vol = vol, cg_stb = stb,
87 cg_lf = lf, cg_rep = idCgRep id }
89 voidIdInfo id = CgIdInfo { cg_id = id, cg_vol = NoVolatileLoc
90 , cg_stb = VoidLoc, cg_lf = mkLFArgument id
92 -- Used just for VoidRep things
94 data VolatileLoc -- These locations die across a call
96 | RegLoc CmmReg -- In one of the registers (global or local)
97 | VirHpLoc VirtualHpOffset -- Hp+offset (address of closure)
98 | VirNodeLoc VirtualHpOffset -- Cts of offset indirect from Node
102 @StableLoc@ encodes where an Id can be found, used by
103 the @CgBindings@ environment in @CgBindery@.
109 | VirStkLoc VirtualSpOffset -- The thing is held in this
112 | VirStkLNE VirtualSpOffset -- A let-no-escape thing; the
113 -- value is this stack pointer
114 -- (as opposed to the contents of the slot)
117 | VoidLoc -- Used only for VoidRep variables. They never need to
118 -- be saved, so it makes sense to treat treat them as
119 -- having a stable location
123 instance Outputable CgIdInfo where
124 ppr (CgIdInfo id rep vol stb lf)
125 = ppr id <+> ptext SLIT("-->") <+> vcat [ppr vol, ppr stb]
127 instance Outputable VolatileLoc where
128 ppr NoVolatileLoc = empty
129 ppr (RegLoc r) = ptext SLIT("reg") <+> ppr r
130 ppr (VirHpLoc v) = ptext SLIT("vh") <+> ppr v
131 ppr (VirNodeLoc v) = ptext SLIT("vn") <+> ppr v
133 instance Outputable StableLoc where
134 ppr NoStableLoc = empty
135 ppr VoidLoc = ptext SLIT("void")
136 ppr (VirStkLoc v) = ptext SLIT("vs") <+> ppr v
137 ppr (VirStkLNE v) = ptext SLIT("lne") <+> ppr v
138 ppr (StableLoc a) = ptext SLIT("amode") <+> ppr a
141 %************************************************************************
143 \subsection[Bindery-idInfo]{Manipulating IdInfo}
145 %************************************************************************
148 stableIdInfo id amode lf_info = mkCgIdInfo id NoVolatileLoc (StableLoc amode) lf_info
149 heapIdInfo id offset lf_info = mkCgIdInfo id (VirHpLoc offset) NoStableLoc lf_info
150 letNoEscapeIdInfo id sp lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLNE sp) lf_info
151 stackIdInfo id sp lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLoc sp) lf_info
152 nodeIdInfo id offset lf_info = mkCgIdInfo id (VirNodeLoc offset) NoStableLoc lf_info
153 regIdInfo id reg lf_info = mkCgIdInfo id (RegLoc reg) NoStableLoc lf_info
155 idInfoToAmode :: CgIdInfo -> FCode CmmExpr
157 = case cg_vol info of {
158 RegLoc reg -> returnFC (CmmReg reg) ;
159 VirNodeLoc nd_off -> returnFC (CmmLoad (cmmOffsetW (CmmReg nodeReg) nd_off) mach_rep) ;
160 VirHpLoc hp_off -> getHpRelOffset hp_off ;
164 StableLoc amode -> returnFC amode
165 VirStkLoc sp_off -> do { sp_rel <- getSpRelOffset sp_off
166 ; return (CmmLoad sp_rel mach_rep) }
168 VirStkLNE sp_off -> getSpRelOffset sp_off ;
170 VoidLoc -> return $ pprPanic "idInfoToAmode: void" (ppr (cg_id info))
171 -- We return a 'bottom' amode, rather than panicing now
172 -- In this way getArgAmode returns a pair of (VoidArg, bottom)
173 -- and that's exactly what we want
175 NoStableLoc -> pprPanic "idInfoToAmode: no loc" (ppr (cg_id info))
178 mach_rep = argMachRep (cg_rep info)
180 cgIdInfoId :: CgIdInfo -> Id
183 cgIdInfoLF :: CgIdInfo -> LambdaFormInfo
186 cgIdInfoArgRep :: CgIdInfo -> CgRep
187 cgIdInfoArgRep = cg_rep
189 maybeLetNoEscape (CgIdInfo { cg_stb = VirStkLNE sp_off }) = Just sp_off
190 maybeLetNoEscape other = Nothing
193 %************************************************************************
195 \subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@}
197 %************************************************************************
199 .There are three basic routines, for adding (@addBindC@), modifying
200 (@modifyBindC@) and looking up (@getCgIdInfo@) bindings.
202 A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple.
203 The name should not already be bound. (nice ASSERT, eh?)
206 addBindC :: Id -> CgIdInfo -> Code
207 addBindC name stuff_to_bind = do
209 setBinds $ extendVarEnv binds name stuff_to_bind
211 addBindsC :: [(Id, CgIdInfo)] -> Code
212 addBindsC new_bindings = do
214 let new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
219 modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code
220 modifyBindC name mangle_fn = do
222 setBinds $ modifyVarEnv mangle_fn binds name
224 getCgIdInfo :: Id -> FCode CgIdInfo
226 = do { -- Try local bindings first
227 ; local_binds <- getBinds
228 ; case lookupVarEnv local_binds id of {
229 Just info -> return info ;
232 { -- Try top-level bindings
233 static_binds <- getStaticBinds
234 ; case lookupVarEnv static_binds id of {
235 Just info -> return info ;
238 -- Should be imported; make up a CgIdInfo for it
242 if isExternalName name then do
243 dflags <- getDynFlags
244 let ext_lbl = CmmLit (CmmLabel (mkClosureLabel dflags name))
245 return (stableIdInfo id ext_lbl (mkLFImported id))
247 if isVoidArg (idCgRep id) then
248 -- Void things are never in the environment
249 return (voidIdInfo id)
256 cgLookupPanic :: Id -> FCode a
258 = do static_binds <- getStaticBinds
259 local_binds <- getBinds
263 ptext SLIT("static binds for:"),
264 vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
265 ptext SLIT("local binds for:"),
266 vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ],
267 ptext SLIT("SRT label") <+> pprCLabel srt
271 %************************************************************************
273 \subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
275 %************************************************************************
277 We sometimes want to nuke all the volatile bindings; we must be sure
278 we don't leave any (NoVolatile, NoStable) binds around...
281 nukeVolatileBinds :: CgBindings -> CgBindings
282 nukeVolatileBinds binds
283 = mkVarEnv (foldr keep_if_stable [] (varEnvElts binds))
285 keep_if_stable (CgIdInfo { cg_stb = NoStableLoc }) acc = acc
286 keep_if_stable info acc
287 = (cg_id info, info { cg_vol = NoVolatileLoc }) : acc
291 %************************************************************************
293 \subsection[lookup-interface]{Interface functions to looking up bindings}
295 %************************************************************************
298 getCAddrModeIfVolatile :: Id -> FCode (Maybe CmmExpr)
299 getCAddrModeIfVolatile id
300 = do { info <- getCgIdInfo id
301 ; case cg_stb info of
302 NoStableLoc -> do -- Aha! So it is volatile!
303 amode <- idInfoToAmode info
305 a_stable_loc -> return Nothing }
308 @getVolatileRegs@ gets a set of live variables, and returns a list of
309 all registers on which these variables depend. These are the regs
310 which must be saved and restored across any C calls. If a variable is
311 both in a volatile location (depending on a register) {\em and} a
312 stable one (notably, on the stack), we modify the current bindings to
313 forget the volatile one.
316 getVolatileRegs :: StgLiveVars -> FCode [GlobalReg]
318 getVolatileRegs vars = do
319 do { stuff <- mapFCs snaffle_it (varSetElems vars)
320 ; returnFC $ catMaybes stuff }
323 { info <- getCgIdInfo var
325 -- commoned-up code...
327 = -- We assume that all regs can die across C calls
328 -- We leave it to the save-macros to decide which
329 -- regs *really* need to be saved.
331 NoStableLoc -> returnFC (Just reg) -- got one!
332 is_a_stable_loc -> do
333 { -- has both volatile & stable locations;
334 -- force it to rely on the stable location
335 modifyBindC var nuke_vol_bind
338 ; case cg_vol info of
339 RegLoc (CmmGlobal reg) -> consider_reg reg
340 VirNodeLoc _ -> consider_reg node
341 other_loc -> returnFC Nothing -- Local registers
344 nuke_vol_bind info = info { cg_vol = NoVolatileLoc }
348 getArgAmode :: StgArg -> FCode (CgRep, CmmExpr)
349 getArgAmode (StgVarArg var)
350 = do { info <- getCgIdInfo var
351 ; amode <- idInfoToAmode info
352 ; return (cgIdInfoArgRep info, amode ) }
354 getArgAmode (StgLitArg lit)
355 = do { cmm_lit <- cgLit lit
356 ; return (typeCgRep (literalType lit), CmmLit cmm_lit) }
358 getArgAmode (StgTypeArg _) = panic "getArgAmode: type arg"
360 getArgAmodes :: [StgArg] -> FCode [(CgRep, CmmExpr)]
361 getArgAmodes [] = returnFC []
362 getArgAmodes (atom:atoms)
363 | isStgTypeArg atom = getArgAmodes atoms
364 | otherwise = do { amode <- getArgAmode atom
365 ; amodes <- getArgAmodes atoms
366 ; return ( amode : amodes ) }
369 %************************************************************************
371 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
373 %************************************************************************
376 bindArgsToStack :: [(Id, VirtualSpOffset)] -> Code
380 bind(id, offset) = addBindC id (stackIdInfo id offset (mkLFArgument id))
382 bindArgsToRegs :: [(Id, GlobalReg)] -> Code
386 bind (arg, reg) = bindNewToReg arg (CmmGlobal reg) (mkLFArgument arg)
388 bindNewToNode :: Id -> VirtualHpOffset -> LambdaFormInfo -> Code
389 bindNewToNode id offset lf_info
390 = addBindC id (nodeIdInfo id offset lf_info)
392 -- Create a new temporary whose unique is that in the id,
393 -- bind the id to it, and return the addressing mode for the
395 bindNewToTemp :: Id -> FCode CmmReg
397 = do addBindC id (regIdInfo id temp_reg lf_info)
401 temp_reg = CmmLocal (LocalReg uniq (argMachRep (idCgRep id)))
402 lf_info = mkLFArgument id -- Always used of things we
403 -- know nothing about
405 bindNewToReg :: Id -> CmmReg -> LambdaFormInfo -> Code
406 bindNewToReg name reg lf_info
409 info = mkCgIdInfo name (RegLoc reg) NoStableLoc lf_info
413 rebindToStack :: Id -> VirtualSpOffset -> Code
414 rebindToStack name offset
415 = modifyBindC name replace_stable_fn
417 replace_stable_fn info = info { cg_stb = VirStkLoc offset }
420 %************************************************************************
422 \subsection[CgMonad-deadslots]{Finding dead stack slots}
424 %************************************************************************
426 nukeDeadBindings does the following:
428 - Removes all bindings from the environment other than those
429 for variables in the argument to nukeDeadBindings.
430 - Collects any stack slots so freed, and returns them to the stack free
432 - Moves the virtual stack pointer to point to the topmost used
435 You can have multi-word slots on the stack (where a Double# used to
436 be, for instance); if dead, such a slot will be reported as *several*
437 offsets (one per word).
439 Probably *naughty* to look inside monad...
442 nukeDeadBindings :: StgLiveVars -- All the *live* variables
444 nukeDeadBindings live_vars = do
446 let (dead_stk_slots, bs') =
449 [ (cg_id b, b) | b <- varEnvElts binds ]
450 setBinds $ mkVarEnv bs'
451 freeStackSlots dead_stk_slots
454 Several boring auxiliary functions to do the dirty work.
457 dead_slots :: StgLiveVars
461 -> ([VirtualSpOffset], [(Id,CgIdInfo)])
463 -- dead_slots carries accumulating parameters for
464 -- filtered bindings, dead slots
465 dead_slots live_vars fbs ds []
466 = (ds, reverse fbs) -- Finished; rm the dups, if any
468 dead_slots live_vars fbs ds ((v,i):bs)
469 | v `elementOfUniqSet` live_vars
470 = dead_slots live_vars ((v,i):fbs) ds bs
471 -- Live, so don't record it in dead slots
472 -- Instead keep it in the filtered bindings
478 -> dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
480 _ -> dead_slots live_vars fbs ds bs
483 size = cgRepSizeW (cg_rep i)
487 getLiveStackSlots :: FCode [VirtualSpOffset]
488 -- Return the offsets of slots in stack containig live pointers
490 = do { binds <- getBinds
491 ; return [off | CgIdInfo { cg_stb = VirStkLoc off,
492 cg_rep = rep } <- varEnvElts binds,
493 isFollowableArg rep] }