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
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
239 if isExternalName name then
240 return (stableIdInfo id ext_lbl (mkLFImported id))
242 if isVoidArg (idCgRep id) then
243 -- Void things are never in the environment
244 return (voidIdInfo id)
251 ext_lbl = CmmLit (CmmLabel (mkClosureLabel name))
253 cgLookupPanic :: Id -> FCode a
255 = do static_binds <- getStaticBinds
256 local_binds <- getBinds
260 ptext SLIT("static binds for:"),
261 vcat [ ppr (cg_id info) | info <- varEnvElts static_binds ],
262 ptext SLIT("local binds for:"),
263 vcat [ ppr (cg_id info) | info <- varEnvElts local_binds ],
264 ptext SLIT("SRT label") <+> pprCLabel srt
268 %************************************************************************
270 \subsection[Bindery-nuke-volatile]{Nuking volatile bindings}
272 %************************************************************************
274 We sometimes want to nuke all the volatile bindings; we must be sure
275 we don't leave any (NoVolatile, NoStable) binds around...
278 nukeVolatileBinds :: CgBindings -> CgBindings
279 nukeVolatileBinds binds
280 = mkVarEnv (foldr keep_if_stable [] (varEnvElts binds))
282 keep_if_stable (CgIdInfo { cg_stb = NoStableLoc }) acc = acc
283 keep_if_stable info acc
284 = (cg_id info, info { cg_vol = NoVolatileLoc }) : acc
288 %************************************************************************
290 \subsection[lookup-interface]{Interface functions to looking up bindings}
292 %************************************************************************
295 getCAddrModeIfVolatile :: Id -> FCode (Maybe CmmExpr)
296 getCAddrModeIfVolatile id
297 = do { info <- getCgIdInfo id
298 ; case cg_stb info of
299 NoStableLoc -> do -- Aha! So it is volatile!
300 amode <- idInfoToAmode info
302 a_stable_loc -> return Nothing }
305 @getVolatileRegs@ gets a set of live variables, and returns a list of
306 all registers on which these variables depend. These are the regs
307 which must be saved and restored across any C calls. If a variable is
308 both in a volatile location (depending on a register) {\em and} a
309 stable one (notably, on the stack), we modify the current bindings to
310 forget the volatile one.
313 getVolatileRegs :: StgLiveVars -> FCode [GlobalReg]
315 getVolatileRegs vars = do
316 do { stuff <- mapFCs snaffle_it (varSetElems vars)
317 ; returnFC $ catMaybes stuff }
320 { info <- getCgIdInfo var
322 -- commoned-up code...
324 = -- We assume that all regs can die across C calls
325 -- We leave it to the save-macros to decide which
326 -- regs *really* need to be saved.
328 NoStableLoc -> returnFC (Just reg) -- got one!
329 is_a_stable_loc -> do
330 { -- has both volatile & stable locations;
331 -- force it to rely on the stable location
332 modifyBindC var nuke_vol_bind
335 ; case cg_vol info of
336 RegLoc (CmmGlobal reg) -> consider_reg reg
337 VirNodeLoc _ -> consider_reg node
338 other_loc -> returnFC Nothing -- Local registers
341 nuke_vol_bind info = info { cg_vol = NoVolatileLoc }
345 getArgAmode :: StgArg -> FCode (CgRep, CmmExpr)
346 getArgAmode (StgVarArg var)
347 = do { info <- getCgIdInfo var
348 ; amode <- idInfoToAmode info
349 ; return (cgIdInfoArgRep info, amode ) }
351 getArgAmode (StgLitArg lit)
352 = do { cmm_lit <- cgLit lit
353 ; return (typeCgRep (literalType lit), CmmLit cmm_lit) }
355 getArgAmode (StgTypeArg _) = panic "getArgAmode: type arg"
357 getArgAmodes :: [StgArg] -> FCode [(CgRep, CmmExpr)]
358 getArgAmodes [] = returnFC []
359 getArgAmodes (atom:atoms)
360 | isStgTypeArg atom = getArgAmodes atoms
361 | otherwise = do { amode <- getArgAmode atom
362 ; amodes <- getArgAmodes atoms
363 ; return ( amode : amodes ) }
366 %************************************************************************
368 \subsection[binding-and-rebinding-interface]{Interface functions for binding and re-binding names}
370 %************************************************************************
373 bindArgsToStack :: [(Id, VirtualSpOffset)] -> Code
377 bind(id, offset) = addBindC id (stackIdInfo id offset (mkLFArgument id))
379 bindArgsToRegs :: [(Id, GlobalReg)] -> Code
383 bind (arg, reg) = bindNewToReg arg (CmmGlobal reg) (mkLFArgument arg)
385 bindNewToNode :: Id -> VirtualHpOffset -> LambdaFormInfo -> Code
386 bindNewToNode id offset lf_info
387 = addBindC id (nodeIdInfo id offset lf_info)
389 -- Create a new temporary whose unique is that in the id,
390 -- bind the id to it, and return the addressing mode for the
392 bindNewToTemp :: Id -> FCode CmmReg
394 = do addBindC id (regIdInfo id temp_reg lf_info)
398 temp_reg = CmmLocal (LocalReg uniq (argMachRep (idCgRep id)))
399 lf_info = mkLFArgument id -- Always used of things we
400 -- know nothing about
402 bindNewToReg :: Id -> CmmReg -> LambdaFormInfo -> Code
403 bindNewToReg name reg lf_info
406 info = mkCgIdInfo name (RegLoc reg) NoStableLoc lf_info
410 rebindToStack :: Id -> VirtualSpOffset -> Code
411 rebindToStack name offset
412 = modifyBindC name replace_stable_fn
414 replace_stable_fn info = info { cg_stb = VirStkLoc offset }
417 %************************************************************************
419 \subsection[CgMonad-deadslots]{Finding dead stack slots}
421 %************************************************************************
423 nukeDeadBindings does the following:
425 - Removes all bindings from the environment other than those
426 for variables in the argument to nukeDeadBindings.
427 - Collects any stack slots so freed, and returns them to the stack free
429 - Moves the virtual stack pointer to point to the topmost used
432 You can have multi-word slots on the stack (where a Double# used to
433 be, for instance); if dead, such a slot will be reported as *several*
434 offsets (one per word).
436 Probably *naughty* to look inside monad...
439 nukeDeadBindings :: StgLiveVars -- All the *live* variables
441 nukeDeadBindings live_vars = do
443 let (dead_stk_slots, bs') =
446 [ (cg_id b, b) | b <- varEnvElts binds ]
447 setBinds $ mkVarEnv bs'
448 freeStackSlots dead_stk_slots
451 Several boring auxiliary functions to do the dirty work.
454 dead_slots :: StgLiveVars
458 -> ([VirtualSpOffset], [(Id,CgIdInfo)])
460 -- dead_slots carries accumulating parameters for
461 -- filtered bindings, dead slots
462 dead_slots live_vars fbs ds []
463 = (ds, reverse fbs) -- Finished; rm the dups, if any
465 dead_slots live_vars fbs ds ((v,i):bs)
466 | v `elementOfUniqSet` live_vars
467 = dead_slots live_vars ((v,i):fbs) ds bs
468 -- Live, so don't record it in dead slots
469 -- Instead keep it in the filtered bindings
475 -> dead_slots live_vars fbs ([offset-size+1 .. offset] ++ ds) bs
477 _ -> dead_slots live_vars fbs ds bs
480 size = cgRepSizeW (cg_rep i)
484 getLiveStackSlots :: FCode [VirtualSpOffset]
485 -- Return the offsets of slots in stack containig live pointers
487 = do { binds <- getBinds
488 ; return [off | CgIdInfo { cg_stb = VirStkLoc off,
489 cg_rep = rep } <- varEnvElts binds,
490 isFollowableArg rep] }