2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
5 \section[CgBindery]{Utility functions related to doing @CgBindings@}
10 StableLoc, VolatileLoc,
12 cgIdInfoId, cgIdInfoArgRep, cgIdInfoLF,
14 stableIdInfo, heapIdInfo,
15 letNoEscapeIdInfo, idInfoToAmode,
23 bindArgsToStack, rebindToStack,
24 bindNewToNode, bindNewToReg, bindArgsToRegs,
26 getArgAmode, getArgAmodes,
28 getCAddrModeIfVolatile, getVolatileRegs,
32 #include "HsVersions.h"
42 import PprCmm ( {- instance Outputable -} )
57 %************************************************************************
59 \subsection[Bindery-datatypes]{Data types}
61 %************************************************************************
63 @(CgBinding a b)@ is a type of finite maps from a to b.
65 The assumption used to be that @lookupCgBind@ must get exactly one
66 match. This is {\em completely wrong} in the case of compiling
67 letrecs (where knot-tying is used). An initial binding is fed in (and
68 never evaluated); eventually, a correct binding is put into the
69 environment. So there can be two bindings for a given name.
72 type CgBindings = IdEnv CgIdInfo
76 { cg_id :: Id -- Id that this is the info for
77 -- Can differ from the Id at occurrence sites by
78 -- virtue of being externalised, for splittable C
80 , cg_vol :: VolatileLoc
82 , cg_lf :: LambdaFormInfo }
84 mkCgIdInfo id vol stb lf
85 = CgIdInfo { cg_id = id, cg_vol = vol, cg_stb = stb,
86 cg_lf = lf, cg_rep = idCgRep id }
88 voidIdInfo id = CgIdInfo { cg_id = id, cg_vol = NoVolatileLoc
89 , cg_stb = VoidLoc, cg_lf = mkLFArgument id
91 -- Used just for VoidRep things
93 data VolatileLoc -- These locations die across a call
95 | RegLoc CmmReg -- In one of the registers (global or local)
96 | VirHpLoc VirtualHpOffset -- Hp+offset (address of closure)
97 | VirNodeLoc VirtualHpOffset -- Cts of offset indirect from Node
101 @StableLoc@ encodes where an Id can be found, used by
102 the @CgBindings@ environment in @CgBindery@.
108 | VirStkLoc VirtualSpOffset -- The thing is held in this
111 | VirStkLNE VirtualSpOffset -- A let-no-escape thing; the
112 -- value is this stack pointer
113 -- (as opposed to the contents of the slot)
116 | VoidLoc -- Used only for VoidRep variables. They never need to
117 -- be saved, so it makes sense to treat treat them as
118 -- having a stable location
122 instance Outputable CgIdInfo where
123 ppr (CgIdInfo id rep vol stb lf)
124 = ppr id <+> ptext SLIT("-->") <+> vcat [ppr vol, ppr stb]
126 instance Outputable VolatileLoc where
127 ppr NoVolatileLoc = empty
128 ppr (RegLoc r) = ptext SLIT("reg") <+> ppr r
129 ppr (VirHpLoc v) = ptext SLIT("vh") <+> ppr v
130 ppr (VirNodeLoc v) = ptext SLIT("vn") <+> ppr v
132 instance Outputable StableLoc where
133 ppr NoStableLoc = empty
134 ppr VoidLoc = ptext SLIT("void")
135 ppr (VirStkLoc v) = ptext SLIT("vs") <+> ppr v
136 ppr (VirStkLNE v) = ptext SLIT("lne") <+> ppr v
137 ppr (StableLoc a) = ptext SLIT("amode") <+> ppr a
140 %************************************************************************
142 \subsection[Bindery-idInfo]{Manipulating IdInfo}
144 %************************************************************************
147 stableIdInfo id amode lf_info = mkCgIdInfo id NoVolatileLoc (StableLoc amode) lf_info
148 heapIdInfo id offset lf_info = mkCgIdInfo id (VirHpLoc offset) NoStableLoc lf_info
149 letNoEscapeIdInfo id sp lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLNE sp) lf_info
150 stackIdInfo id sp lf_info = mkCgIdInfo id NoVolatileLoc (VirStkLoc sp) lf_info
151 nodeIdInfo id offset lf_info = mkCgIdInfo id (VirNodeLoc offset) NoStableLoc lf_info
152 regIdInfo id reg lf_info = mkCgIdInfo id (RegLoc reg) NoStableLoc lf_info
154 idInfoToAmode :: CgIdInfo -> FCode CmmExpr
156 = case cg_vol info of {
157 RegLoc reg -> returnFC (CmmReg reg) ;
158 VirNodeLoc nd_off -> returnFC (CmmLoad (cmmOffsetW (CmmReg nodeReg) nd_off) mach_rep) ;
159 VirHpLoc hp_off -> getHpRelOffset hp_off ;
163 StableLoc amode -> returnFC amode
164 VirStkLoc sp_off -> do { sp_rel <- getSpRelOffset sp_off
165 ; return (CmmLoad sp_rel mach_rep) }
167 VirStkLNE sp_off -> getSpRelOffset sp_off
169 VoidLoc -> return $ pprPanic "idInfoToAmode: void" (ppr (cg_id info))
170 -- We return a 'bottom' amode, rather than panicing now
171 -- In this way getArgAmode returns a pair of (VoidArg, bottom)
172 -- and that's exactly what we want
174 NoStableLoc -> pprPanic "idInfoToAmode: no loc" (ppr (cg_id info))
177 mach_rep = argMachRep (cg_rep info)
179 cgIdInfoId :: CgIdInfo -> Id
182 cgIdInfoLF :: CgIdInfo -> LambdaFormInfo
185 cgIdInfoArgRep :: CgIdInfo -> CgRep
186 cgIdInfoArgRep = cg_rep
188 maybeLetNoEscape (CgIdInfo { cg_stb = VirStkLNE sp_off }) = Just sp_off
189 maybeLetNoEscape other = Nothing
192 %************************************************************************
194 \subsection[CgMonad-bindery]{Monad things for fiddling with @CgBindings@}
196 %************************************************************************
198 .There are three basic routines, for adding (@addBindC@), modifying
199 (@modifyBindC@) and looking up (@getCgIdInfo@) bindings.
201 A @Id@ is bound to a @(VolatileLoc, StableLoc)@ triple.
202 The name should not already be bound. (nice ASSERT, eh?)
205 addBindC :: Id -> CgIdInfo -> Code
206 addBindC name stuff_to_bind = do
208 setBinds $ extendVarEnv binds name stuff_to_bind
210 addBindsC :: [(Id, CgIdInfo)] -> Code
211 addBindsC new_bindings = do
213 let new_binds = foldl (\ binds (name,info) -> extendVarEnv binds name info)
218 modifyBindC :: Id -> (CgIdInfo -> CgIdInfo) -> Code
219 modifyBindC name mangle_fn = do
221 setBinds $ modifyVarEnv mangle_fn binds name
223 getCgIdInfo :: Id -> FCode CgIdInfo
225 = do { -- Try local bindings first
226 ; local_binds <- getBinds
227 ; case lookupVarEnv local_binds id of {
228 Just info -> return info ;
231 { -- Try top-level bindings
232 static_binds <- getStaticBinds
233 ; case lookupVarEnv static_binds id of {
234 Just info -> return info ;
237 -- Should be imported; make up a CgIdInfo for it
241 if isExternalName name then do
242 this_pkg <- getThisPackage
243 let ext_lbl = CmmLit (CmmLabel (mkClosureLabel this_pkg name))
244 return (stableIdInfo id ext_lbl (mkLFImported id))
246 if isVoidArg (idCgRep id) then
247 -- Void things are never in the environment
248 return (voidIdInfo id)
255 cgLookupPanic :: Id -> FCode a
257 = do static_binds <- getStaticBinds
258 local_binds <- getBinds
262 ptext SLIT("static binds for:"),
263 vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
264 ptext SLIT("local binds for:"),
265 vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ],
266 ptext SLIT("SRT label") <+> pprCLabel srt
270 %************************************************************************
272 \subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
274 %************************************************************************
276 We sometimes want to nuke all the volatile bindings; we must be sure
277 we don't leave any (NoVolatile, NoStable) binds around...
280 nukeVolatileBinds :: CgBindings -> CgBindings
281 nukeVolatileBinds binds
282 = mkVarEnv (foldr keep_if_stable [] (varEnvElts binds))
284 keep_if_stable (CgIdInfo { cg_stb = NoStableLoc }) acc = acc
285 keep_if_stable info acc
286 = (cg_id info, info { cg_vol = NoVolatileLoc }) : acc
290 %************************************************************************
292 \subsection[lookup-interface]{Interface functions to looking up bindings}
294 %************************************************************************
297 getCAddrModeIfVolatile :: Id -> FCode (Maybe CmmExpr)
298 getCAddrModeIfVolatile id
299 = do { info <- getCgIdInfo id
300 ; case cg_stb info of
301 NoStableLoc -> do -- Aha! So it is volatile!
302 amode <- idInfoToAmode info
304 a_stable_loc -> return Nothing }
307 @getVolatileRegs@ gets a set of live variables, and returns a list of
308 all registers on which these variables depend. These are the regs
309 which must be saved and restored across any C calls. If a variable is
310 both in a volatile location (depending on a register) {\em and} a
311 stable one (notably, on the stack), we modify the current bindings to
312 forget the volatile one.
315 getVolatileRegs :: StgLiveVars -> FCode [GlobalReg]
317 getVolatileRegs vars = do
318 do { stuff <- mapFCs snaffle_it (varSetElems vars)
319 ; returnFC $ catMaybes stuff }
322 { info <- getCgIdInfo var
324 -- commoned-up code...
326 = -- We assume that all regs can die across C calls
327 -- We leave it to the save-macros to decide which
328 -- regs *really* need to be saved.
330 NoStableLoc -> returnFC (Just reg) -- got one!
331 is_a_stable_loc -> do
332 { -- has both volatile & stable locations;
333 -- force it to rely on the stable location
334 modifyBindC var nuke_vol_bind
337 ; case cg_vol info of
338 RegLoc (CmmGlobal reg) -> consider_reg reg
339 VirNodeLoc _ -> consider_reg node
340 other_loc -> returnFC Nothing -- Local registers
343 nuke_vol_bind info = info { cg_vol = NoVolatileLoc }
347 getArgAmode :: StgArg -> FCode (CgRep, CmmExpr)
348 getArgAmode (StgVarArg var)
349 = do { info <- getCgIdInfo var
350 ; amode <- idInfoToAmode info
351 ; return (cgIdInfoArgRep info, amode ) }
353 getArgAmode (StgLitArg lit)
354 = do { cmm_lit <- cgLit lit
355 ; return (typeCgRep (literalType lit), CmmLit cmm_lit) }
357 getArgAmode (StgTypeArg _) = panic "getArgAmode: type arg"
359 getArgAmodes :: [StgArg] -> FCode [(CgRep, CmmExpr)]
360 getArgAmodes [] = returnFC []
361 getArgAmodes (atom:atoms)
362 | isStgTypeArg atom = getArgAmodes atoms
363 | otherwise = do { amode <- getArgAmode atom
364 ; amodes <- getArgAmodes atoms
365 ; return ( amode : amodes ) }
368 %************************************************************************
370 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
372 %************************************************************************
375 bindArgsToStack :: [(Id, VirtualSpOffset)] -> Code
379 bind(id, offset) = addBindC id (stackIdInfo id offset (mkLFArgument id))
381 bindArgsToRegs :: [(Id, GlobalReg)] -> Code
385 bind (arg, reg) = bindNewToReg arg (CmmGlobal reg) (mkLFArgument arg)
387 bindNewToNode :: Id -> VirtualHpOffset -> LambdaFormInfo -> Code
388 bindNewToNode id offset lf_info
389 = addBindC id (nodeIdInfo id offset lf_info)
391 -- Create a new temporary whose unique is that in the id,
392 -- bind the id to it, and return the addressing mode for the
394 bindNewToTemp :: Id -> FCode CmmReg
396 = do addBindC id (regIdInfo id temp_reg lf_info)
400 temp_reg = CmmLocal (LocalReg uniq (argMachRep (idCgRep id)))
401 lf_info = mkLFArgument id -- Always used of things we
402 -- know nothing about
404 bindNewToReg :: Id -> CmmReg -> LambdaFormInfo -> Code
405 bindNewToReg name reg lf_info
408 info = mkCgIdInfo name (RegLoc reg) NoStableLoc lf_info
412 rebindToStack :: Id -> VirtualSpOffset -> Code
413 rebindToStack name offset
414 = modifyBindC name replace_stable_fn
416 replace_stable_fn info = info { cg_stb = VirStkLoc offset }
419 %************************************************************************
421 \subsection[CgMonad-deadslots]{Finding dead stack slots}
423 %************************************************************************
425 nukeDeadBindings does the following:
427 - Removes all bindings from the environment other than those
428 for variables in the argument to nukeDeadBindings.
429 - Collects any stack slots so freed, and returns them to the stack free
431 - Moves the virtual stack pointer to point to the topmost used
434 You can have multi-word slots on the stack (where a Double# used to
435 be, for instance); if dead, such a slot will be reported as *several*
436 offsets (one per word).
438 Probably *naughty* to look inside monad...
441 nukeDeadBindings :: StgLiveVars -- All the *live* variables
443 nukeDeadBindings live_vars = do
445 let (dead_stk_slots, bs') =
448 [ (cg_id b, b) | b <- varEnvElts binds ]
449 setBinds $ mkVarEnv bs'
450 freeStackSlots dead_stk_slots
453 Several boring auxiliary functions to do the dirty work.
456 dead_slots :: StgLiveVars
460 -> ([VirtualSpOffset], [(Id,CgIdInfo)])
462 -- dead_slots carries accumulating parameters for
463 -- filtered bindings, dead slots
464 dead_slots live_vars fbs ds []
465 = (ds, reverse fbs) -- Finished; rm the dups, if any
467 dead_slots live_vars fbs ds ((v,i):bs)
468 | v `elementOfUniqSet` live_vars
469 = dead_slots live_vars ((v,i):fbs) ds bs
470 -- Live, so don't record it in dead slots
471 -- Instead keep it in the filtered bindings
477 -> dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
479 _ -> dead_slots live_vars fbs ds bs
482 size = cgRepSizeW (cg_rep i)
486 getLiveStackSlots :: FCode [VirtualSpOffset]
487 -- Return the offsets of slots in stack containig live pointers
489 = do { binds <- getBinds
490 ; return [off | CgIdInfo { cg_stb = VirStkLoc off,
491 cg_rep = rep } <- varEnvElts binds,
492 isFollowableArg rep] }